#!/usr/bin/perl -w
#########################################################################
#        This Perl script is Copyright (c) 2002, Peter J Billam         #
#               c/o P J B Computing, www.pjb.com.au                     #
#                                                                       #
#     This script is free software; you can redistribute it and/or      #
#            modify it under the same terms as Perl itself.             #
#########################################################################

# use Class::MakeMethods::Utility::Ref qw( ref_clone ref_compare );
use Data::Dumper;
use Test::Simple tests => 25;

sub pp {
	my $t = "/tmp/test.$$";
	open(T, '>', $t) or die "can't open $t: $!\n";
	print T @_,"\n";
	close T;
	open(P, '-|', "muscript -pp $t") or die "can't run muscript -pp $t: $!\n";
	my @output = (<P>);
	close P;
	return join('', @output);
}

my $in = <<'EOT';
$A = rabbit? A : B ?
=1 $A $A $A $A $A $A $A $A
EOT
ok(pp($in) eq <<'EOT', "rabbit");
=1 A B A A B A B A
EOT

# $xxx = <<'XXX';

$in = <<'EOT';
$A = cycle? [A B] : [A c] : [B c] ?
=1 $A $A $A $A $A $A $A $A $A
EOT
ok(pp($in) eq <<'EOT', "cycle");
=1 [A B] [A c] [B c] [A B] [A c] [B c] [A B] [A c] [B c]
EOT

$in = <<'EOT';
$A = aaba? D : E ?
=1 $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A
=1 $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A
=1 $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A
=1 $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A
EOT
ok(pp($in) eq <<'EOT', "abba");
=1 D D E D D D E D E E D E D D E D
=1 D D E D D D E D E E D E D D E D
=1 E E D E E E D E D D E D E E D E
=1 D D E D D D E D E E D E D D E D
EOT

warn "# this next test will fail randomly about 4 times per thousand...\n";
$in = <<'EOT';
$A = random? C : D : E : F ?
=1 $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A
EOT
my $ra = pp($in);
my $l = length $ra;
ok(($l==51) && ($ra=~/C/) && ($ra=~/D/) && ($ra=~/E/) && ($ra=~/F/), "random");

$in = <<'EOT';
$A = morse_thue? A : B ?
=1 $A $A $A $A $A $A $A $A
EOT
ok(pp($in) eq <<'EOT', "morse_thue with 2 elements");
=1 A B B A B A A B
EOT

$in = <<'EOT';
$B = morse_thue? A : B : c?
$A = $B $B $B
=1 $A $A $A $A $A $A $A $A $A
EOT
ok(pp($in) eq <<'EOT', "morse_thue with 3 elements");
=1 A B c B c A c A B B c A c A B A B c c A B A B c B c A
EOT

$in = <<'EOT';
$A = leibnitz? 2 : A : B : c : d : e ?
=1 $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A
EOT
ok(pp($in) eq <<'EOT', "leibnitz with n=2");
=1 A B B c B c c d B c c d c d d e
EOT

$in = <<'EOT';
$A = leibnitz? 3 : A : B : c : d : e : f ?
=1 $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A $A
EOT
ok(pp($in) eq <<'EOT', "leibnitz with n=3");
=1 A B c B c d c d e B c d c d e d e f
EOT

$in = <<'EOT';
$A = cycle? D# : F# : A ?
$B = [$A $A]
=1 treble $B $B $B $B
EOT
ok(pp($in) eq <<'EOT', "substitution recursively at substitution-time ( = )");
=1 treble [D# F#] [A D#] [F# A] [D# F#]
EOT

$in = <<'EOT';
$F = cycle? A : a ?
$A = cycle? [$F en] : [$F eb] : [$F d] ?
=1 4 $A $A $A $A $A $A $A $A $A
EOT
ok(pp($in) eq <<'EOT', "cycle, one of whose elements is a cycle");
=1 4 [A en] [a eb] [A d] [a en] [A eb] [a d] [A en] [a eb] [A d]
EOT

$in = <<'EOT';
$A = cycle? D# : F# : A ?
$B == [$A $A]
=1 treble $B $B $B $B
EOT
# warn pp($in);
ok(pp($in) eq <<'EOT', "substitution forced at definition-time ( == )");
=1 treble [D# F#] [D# F#] [D# F#] [D# F#]
EOT

$in = <<'EOT';
$RIFF8 == [A, e d# e] [c' G# A E]
=1 treble $RIFF8 $RIFF8
EOT
ok(pp($in) eq <<'EOT', "longer variable-name");
=1 treble [A, e d# e] [c' G# A E] [A, e d# e] [c' G# A E]
EOT

$in = <<'EOT';
$M = {
|
=1 4 A B c d
=2 2 A G
}
$M
$M
EOT
# warn pp($in);
ok(pp($in) eq <<'EOT', "multiline variable");
|
=1 4 A B c d
=2 2 A G
|
=1 4 A B c d
=2 2 A G
EOT

$in = <<'EOT';
$M = {
|
=1 4 A B \
c d
=2 2 A G
}
$M
$M
EOT
ok(pp($in) eq <<'EOT', "escaped newline in a multiline variable");
|
=1 4 A B c d
=2 2 A G
|
=1 4 A B c d
=2 2 A G
EOT

$in = <<'EOT';
$M = {
|
   =1 4 A B c d
   =2 2 A G
}
$M
$M
EOT
ok(pp($in) eq <<'EOT', "leading space in a multiline variable");
|
=1 4 A B c d
=2 2 A G
|
=1 4 A B c d
=2 2 A G
EOT

$in = <<'EOT';
$M = { # this is a comment
|
   =1 4 A B c d
   =2 2 A G
}
$M
$M
EOT
ok(pp($in) eq <<'EOT', "multiline variable with a comment");
|
=1 4 A B c d
=2 2 A G
|
=1 4 A B c d
=2 2 A G
EOT

$in = <<'EOT';
$M = {
|
=1 4 A B c d
=2 2 A G
}
$N = {
|
=1 4 e d c A
=2 2 G# 4 A d
}
$M $N $M
EOT
ok(pp($in) eq <<'EOT', "multiline vars substituted on one line");
|
=1 4 A B c d
=2 2 A G
|
=1 4 e d c A
=2 2 G# 4 A d
|
=1 4 A B c d
=2 2 A G
EOT

$in = <<'EOT';
$M = {
|
=1 4 A B c d
=2 2 A G
}
$N = {
|
=1 4 e d c A
=2 2 G# 4 A d
}
$MT = morse_thue? $M : $N ?
$MT $MT $MT $MT
EOT
ok(pp($in) eq <<'EOT', "multiline vars as generator arguments");
|
=1 4 A B c d
=2 2 A G
|
=1 4 e d c A
=2 2 G# 4 A d
|
=1 4 e d c A
=2 2 G# 4 A d
|
=1 4 A B c d
=2 2 A G
EOT

$in = <<'EOT';
$A = A
$M = {
|
=1 4 $A B c d
=2 2 $A G
}
$N = {
|
=1 4 e d c $A
=2 2 G# 4 $A d
}
$MT = morse_thue? $M : $N ?
$MT $MT $MT $MT
EOT
ok(pp($in) eq <<'EOT', "variables within a multiline var");
|
=1 4 A B c d
=2 2 A G
|
=1 4 e d c A
=2 2 G# 4 A d
|
=1 4 e d c A
=2 2 G# 4 A d
|
=1 4 A B c d
=2 2 A G
EOT

$in = <<'EOT';
$A = A
$M == {
|
=1 4 $A B c d
=2 2 $A G
}
$N == {
|
=1 4 e d c $A
=2 2 G# 4 $A d
}
$MT = morse_thue? $M : $N ?
$MT $MT $MT $MT
EOT
ok(pp($in) eq <<'EOT', "likewise with substitution at definition-time ( == )");
|
=1 4 A B c d
=2 2 A G
|
=1 4 e d c A
=2 2 G# 4 A d
|
=1 4 e d c A
=2 2 G# 4 A d
|
=1 4 A B c d
=2 2 A G
EOT

$in = <<'EOT';
$A = rabbit? A : Bb ?
$M = {
|
=1 4 $A B c d
=2 2 $A G
}
$N = {
|
=1 4 e d c $A
=2 2 G# 4 $A d
}
$M $N $N $M
EOT
$out = <<'EOT';
|
=1 4 A B c d
=2 2 Bb G
|
=1 4 e d c A
=2 2 G# 4 A d
|
=1 4 e d c Bb
=2 2 G# 4 A d
|
=1 4 Bb B c d
=2 2 A G
EOT
ok(pp($in) eq $out, "generated variables within a multiline var");


$in = <<'EOT';
$A = rabbit? A : Bb ?
$M == {
|
=1 4 $A B c d
=2 2 $A G
}
$N == {
|
=1 4 e d c $A
=2 2 G# 4 $A d
}
$M $N $N $M
EOT
ok(pp($in) eq <<'EOT', "likewise with substitution at definition-time ( == )");
|
=1 4 A B c d
=2 2 Bb G
|
=1 4 e d c A
=2 2 G# 4 A d
|
=1 4 e d c A
=2 2 G# 4 A d
|
=1 4 A B c d
=2 2 Bb G
EOT

$in = <<'EOT';
$Z=rabbit? A : Bb ?
$M={
|
=1 8 $Z B $Z c $Z d $Z c
=2 2 $Z $Z
|
$Z=rabbit? c : d ?
=1 8 $Z B $Z c $Z d $Z c
=2 2 G# 4 $Z d
}
$M
EOT
$out = <<'EOT';
|
=1 8 A B Bb c A d A c
=2 2 Bb A
|
=1 8 c B d c c d c c
=2 2 G# 4 d d
EOT
#warn "in =\n$in";
#warn "pp output was =\n".pp($in);
#warn "should be =\n$out";
ok(pp($in) eq $out, "multiline var contains a variable definition");

$in = <<'EOT';
$A=A
$B=Bb
$Z=rabbit? $A : $B ?
$M={
|
=1 8 $Z B $Z c $Z d $Z c
=2 2 $Z $Z
|
$A=c
$B=d
=1 8 $Z B $Z c $Z d $Z c
=2 2 G# 4 $Z d
}
$M
EOT
$out = <<'EOT';
|
=1 8 A B Bb c A d A c
=2 2 Bb A
|
=1 8 d B c c c d d c
=2 2 G# 4 c d
EOT
ok(pp($in) eq $out, "same with args changed instead of function restarted");

$in = <<'EOT';
# $A=A
% $B=Bb
$Z=rabbit? $A : $B ?
|
EOT
$out = <<'EOT';
% $B=Bb
|
EOT
#warn "in =\n$in";
#warn "pp output was =\n".pp($in);
#warn "should be =\n$out";
ok(pp($in) eq $out, "no substitution attempted on comment-lines");