#!/usr/bin/perl
# -*- Mode: cperl -*-
use FileHandle;
use IPC::Open2;

# open the lc program
print "testing lc...\n";
my $pid = open2(*LCREADER, *LCWRITER, './lc', '=qa');

# paste in the test script
print LCWRITER <<EOF;
# this is the test script
print top

# substitution
A=Lx.xx
B=aa
a=variable 0 B
C=[A/a]B
print C

# simple step
D=step C
print D
D=step C
print D

# simple reduction that doesn't terminate
E=reduce C

# substitution with clashes
A=Lx.xyz
B=xz
y=variable 0 A
C=[B/y]A
print C

# similar substitution with clashes
A=Lx.xyz
B=xz
z=variable 1 A
C=[B/z]A
print C

# also doesn't terminate
A=((Lx.(xxx))(Lx.(xxx)))
reduce A
print A

# variable clash
A=((Lxyz.xyz))zz
print A
A=step A
print A
A=step A
print A

# various applications
A=a((Lx.xx)ww)((Ly.yy)xx)
A=reduce A
print A

# doesn't change on reduction
A=a(Lx.x)b
A=reduce A
print A

# alpha renaming
# there is no interface for this, actually, just substitute one variable for another
A=foo
variables A
o=variable 1 A
rename o e
print A

# some other tests
A=Lx.xy
A=reduce A
print A

A=Ly.Lx.(xy)
A=reduce A
print A

A=((Lx.(xx)))a)
A=reduce A
print A

A=(Lx.xx)(La.ax)d
A=reduce A
print A

A=(Lx.xx)((La.ax)d)
A=reduce A
print A

A=(c(Lx.xx)a)
A=reduce A
print A

A=(((Lx.(Ly.xy))a)b)
A=reduce A
print A

A=(Lx.Ly.xy)ab
A=reduce A
print A

A=(Lx.(Ly.xy)ab)
A=reduce A
print A

A=(Lx.(Ly.xy)a)b
A=reduce A
print A

# end
quit
EOF

my $expected = 'top
(Lx.xx)(Lx.xx)
(Lx.xx)(Lx.xx)
(Lx.xx)(Lx.xx)
error:
#<interpreter-reduction-aborted message "beta reduction did not terminate">
Lv1.v1(xz)z
Lv2.v2y(xz)
error:
#<interpreter-reduction-aborted message "beta reduction did not terminate">
(Lx.xxx)(Lx.xxx)
(Lxyz.xyz)zz
(Lyv3.zyv3)z
Lv3.zzv3
a(www)(xxx)
a(Lx.x)b
variable 0: f
variable 1: o
fee
Lx.xy
Lyx.xy
aa
xxd
dx(dx)
c(Lx.xx)a
ab
ab
Lx.xab
ba
';

print "reading results...\n";
# read back what we got
local $/ = undef;
my $result = <LCREADER>;

# close the lc program
waitpid($pid, 0);

# compare the output to expected results
if ($result eq $expected) {
    print "test passed\n";
} else {
    print "test failed\n";
    print $result;
    # XXX need better error reporting...
}