Anarres-Mud-Driver-0.26/
Anarres-Mud-Driver-0.26/Efun/
Anarres-Mud-Driver-0.26/Efun/Core/
Anarres-Mud-Driver-0.26/Interpreter/
Anarres-Mud-Driver-0.26/Type/
Anarres-Mud-Driver-0.26/include/
Anarres-Mud-Driver-0.26/lib/
Anarres-Mud-Driver-0.26/lib/Driver/
Anarres-Mud-Driver-0.26/lib/Driver/Compiler/
Anarres-Mud-Driver-0.26/lib/Driver/Program/
use strict;
use Data::Dumper;
use Test::More tests => 24;

my ($t, $u, $v, $w);

BEGIN { use_ok('Anarres::Mud::Driver::Compiler::Type', ':all'); }

$t = T_STRING;
ok($$t eq 's', 'Construct T_STRING (from cache)');

$t = new Anarres::Mud::Driver::Compiler::Type("*s");
ok($$t eq '*s', 'Construct string pointer');

$t = new Anarres::Mud::Driver::Compiler::Type("*s");
ok($$t eq '*s', 'Construct string pointer from cache');

$t = T_CLASS("a", T_STRING);
ok($$t =~ m/^{/, 'Construct T_CLASS');
ok($t->dump eq '{a:s}', 'Class dump looks OK');

$t = T_CLASS("b", T_STRING, T_INTEGER, T_CLASS("c", T_STRING, T_INTEGER));
ok($$t =~ m/^{/, 'Construct complex T_CLASS');
# print STDERR $t->dump, "\n";
ok($t->dump eq '{b:si{c:si}}', 'Complex class dump looks OK');

my $cond = 1;
my $cache = \%Anarres::Mud::Driver::Compiler::Type::CACHE;
foreach (keys %$cache) {
	$cond = 0 unless $_ eq ${$cache->{$_}};
}
ok($cond, 'Cache integrity check');

$t = T_CLASS("d", T_STRING, T_INTEGER, T_CLASS("e", T_STRING, T_INTEGER));
$u = T_CLASS("f", T_STRING, T_INTEGER, T_CLASS("g", T_STRING));
my $v = $t->array;
my $w = $u->array;

my ($td, $ud, $vd, $wd) = map { $_->dump } ($t, $u, $v, $w);

ok(T_NIL->compatible(T_INTEGER), 'Can assign NIL to INTEGER');
ok(T_BOOL->compatible(T_INTEGER), 'Can assign BOOL to INTEGER');
ok(!(T_INTEGER->compatible(T_NIL)), 'Cannot assign INTEGER to NIL');
ok(!(T_INTEGER->compatible(T_BOOL)), 'Cannot assign INTEGER to BOOL');
ok(T_NIL->compatible(T_CLASS("h", T_INTEGER)), 'Can assign NIL to class');
ok($t->compatible($t), 'Can assign $t to itself');
ok($u->compatible($u), 'Can assign $u to itself');
ok(!($t->compatible($u)), 'Cannot assign simple class to complex');
ok(!($u->compatible($t)), 'Cannot assign complex class to simple');

ok(T_NIL->unify(T_INTEGER)->equals(T_INTEGER), 'U(n, i) = i');
ok(T_INTEGER->unify(T_INTEGER)->equals(T_INTEGER), 'U(i, i) = i');
ok(T_STRING->unify(T_INTEGER)->equals(T_UNKNOWN), 'U(s, i) = ?');
ok($u->unify($u)->equals($u), "U($ud, $ud) = $ud");
ok($u->unify($t)->equals(T_UNKNOWN), "U($ud, $td) = ?");
ok($v->unify($w)->equals(T_UNKNOWN->array), "U($vd, $wd) = *?");