Yet more fun with testing... patch at bottom, rambling first
noop didn't have a test, ironic yes, but imagine the shame if it didn't work.
Also time and bitwise ops tests. For the bitwise ops I've tried to be
platform nice, these tests merely exercise the ops, rather than anything
else.
BUG: clear_s NULLs the string regs, so print_s on them segfaults.
added test but skipped it...
Looking at the print* ops, do we have a way to tell if a print failed?
Will we want one at some point?
We have shr_i_ic and friends, but not shr_i_i, is there good reason?
With addition of this patch (below) only following ops remain without tests:
print_nc
push_p
pop_p
clear_p
These ops have tests, but are skipped due to problems or being broken:
clear_s
jump_i
Alex Gough
--
If you are not too long, I will wait here for you all my life.
########### against a snapshot from a few hours ago (ish..)
--- clean/parrot/MANIFEST Mon Sep 24 20:00:01 2001
+++ parrot/MANIFEST Tue Sep 25 00:13:32 2001
@@ -65,9 +65,11 @@
t/local_label.pasm
t/op/basic.t
t/op/integer.t
+t/op/bitwise.t
t/op/number.t
t/op/stacks.t
t/op/string.t
+t/op/time.t
t/op/trans.t
t/test.pasm
t/test2.pasm
diff -urN clean/parrot/t/op/basic.t parrot/t/op/basic.t
--- clean/parrot/t/op/basic.t Sun Sep 16 17:21:16 2001
+++ parrot/t/op/basic.t Mon Sep 24 23:00:08 2001
@@ -1,6 +1,22 @@
#! perl -w
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 5;
+
+# It would be very embarrassing if these didn't work...
+output_is(<<'CODE', '', "noop, end");
+ noop
+ end
+CODE
+
+output_is(<<'CODE', '1', "print 1");
+ print 1
+ end
+CODE
+
+output_is(<<'CODE', 'Parrot flies', "print string");
+ print "Parrot flies"
+ end
+CODE
output_is( <<'CODE', '42', "branch_ic" );
set I4, 42
diff -urN clean/parrot/t/op/bitwise.t parrot/t/op/bitwise.t
--- clean/parrot/t/op/bitwise.t Thu Jan 1 01:00:00 1970
+++ parrot/t/op/bitwise.t Tue Sep 25 00:09:12 2001
@@ -0,0 +1,78 @@
+#! perl -w
+
+use Parrot::Test tests => 4;
+
+output_is(<<'CODE', <<'OUTPUT', "shr_i_ic (>>)");
+ set I0, 0b001100
+ set I1, 0b010100
+ shr I2, I0, 1
+ shr I1, I1, 2
+ print I2
+ print "\n"
+ print I1
+ print "\n"
+ print I0
+ print "\n"
+ end
+CODE
+6
+5
+12
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "xor_i");
+ set I0, 0b001100
+ set I1, 0b100110
+ xor I2, I0, I1
+ print I2
+ print "\n"
+ xor I1, I0, I1
+ print I1
+ print "\n"
+ print I0
+ print "\n"
+ end
+CODE
+42
+42
+12
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "and_i");
+ set I0, 0b001100
+ set I1, 0b010110
+ and I2, I0,I1
+ print I2
+ print "\n"
+ and I1,I0,I1
+ print I1
+ print "\n"
+ print I0
+ print "\n"
+CODE
+4
+4
+12
+OUTPUT
+
+# use C<and> to only check low order bits, this should be platform nice
+output_is(<<'CODE', <<'OUTPUT', "not_i");
+ set I0, 0b001100
+ set I1, 0b001100
+ set I31, 0b111111
+ not I2, I0
+ and I2, I2, I31
+ print I2
+ print "\n"
+ not I1, I1
+ and I1, I1, I31
+ print I1
+ print "\n"
+ print I0
+ print "\n"
+CODE
+51
+51
+12
+OUTPUT
+1;
diff -urN clean/parrot/t/op/integer.t parrot/t/op/integer.t
--- clean/parrot/t/op/integer.t Thu Sep 20 20:00:01 2001
+++ parrot/t/op/integer.t Tue Sep 25 00:20:20 2001
@@ -814,3 +814,5 @@
CODE
00000000000000000000000000000000
OUTPUT
+
+1;
diff -urN clean/parrot/t/op/string.t parrot/t/op/string.t
--- clean/parrot/t/op/string.t Mon Sep 24 20:00:01 2001
+++ parrot/t/op/string.t Tue Sep 25 00:08:50 2001
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 9;
+use Parrot::Test tests => 10;
output_is( <<'CODE', <<OUTPUT, "set_s_sc" );
set S4, "JAPH\n"
@@ -117,3 +117,35 @@
CODE
fishbone
OUTPUT
+
+SKIP: { skip("TODO: printing empty string reg segfaults",1);
+output_is(<<"CODE", <<'OUTPUT', "clear_s");
+@{[ set_str_regs( sub {"BOO $_[0]\\n"} ) ]}
+ clear_s
+@{[ print_str_regs() ]}
+ print "done\\n"
+ end
+CODE
+done
+OUTPUT
+}
+
+# Set all string registers to values given by &$_[0](reg num)
+sub set_str_regs {
+ my $code = shift;
+ my $rt;
+ for (0..31) {
+ $rt .= "\tset S$_, \"".&$code($_)."\"\n";
+ }
+ return $rt;
+}
+# print string registers, no additional prints
+sub print_str_regs {
+ my $rt;
+ for (0..31) {
+ $rt .= "\tprint S$_\n";
+ }
+ return $rt;
+}
+
+1;
diff -urN clean/parrot/t/op/time.t parrot/t/op/time.t
--- clean/parrot/t/op/time.t Thu Jan 1 01:00:00 1970
+++ parrot/t/op/time.t Mon Sep 24 23:45:19 2001
@@ -0,0 +1,40 @@
+#! perl -w
+
+use Parrot::Test tests => 2;
+
+output_is(<<'CODE', <<'OUTPUT', "time_i");
+ time I0
+ time I1
+ ge I0, 0, OK1
+ branch FAIL
+OK1: print "ok, (!= 1970) Grateful Dead not\n"
+ ge I1, I0, OK2
+ branch FAIL
+OK2: print "ok, (now>before) timelords need not apply\n"
+ branch OK_ALL
+FAIL: print "failure\n"
+OK_ALL:
+ end
+CODE
+ok, (!= 1970) Grateful Dead not
+ok, (now>before) timelords need not apply
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "time_n");
+ time N0
+ time N1
+ ge N0, 0, OK1
+ branch FAIL
+OK1: print "ok, (!= 1970) Grateful Dead not\n"
+ ge N1, N0, OK2
+ branch FAIL
+OK2: print "ok, (now>before) timelords need not apply\n"
+ branch OK_ALL
+FAIL: print "failure\n"
+OK_ALL:
+ end
+CODE
+ok, (!= 1970) Grateful Dead not
+ok, (now>before) timelords need not apply
+OUTPUT
+1;
