# New Ticket Created by Simon Glover
# Please include the string: [netlabs #644]
# in the subject line of all future correspondence about this issue.
# <URL: http://bugs6.perl.org/rt2/Ticket/Display.html?id=644 >
This patch adds tests for the index, depth & intdepth ops, as well
as adding an extra test for intsave/intrestore.
Simon
--- t/op/string.t.old Fri May 31 17:04:18 2002
+++ t/op/string.t Fri May 31 17:33:25 2002
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 77;
+use Parrot::Test tests => 82;
output_is( <<'CODE', <<OUTPUT, "set_s_s|sc" );
set S4, "JAPH\n"
@@ -1012,6 +1012,133 @@
end
CODE
+output_is(<<'CODE',<<OUTPUT,"index, 3-arg form");
+ set S0, "Parrot"
+ set S1, "Par"
+ index I1, S0, S1
+ print I1
+ print "\n"
+
+ set S1, "rot"
+ index I1, S0, S1
+ print I1
+ print "\n"
+
+ set S1, "bar"
+ index I1, S0, S1
+ print I1
+ print "\n"
+
+ end
+CODE
+0
+3
+-1
+OUTPUT
+
+output_is(<<'CODE',<<OUTPUT,"index, 4-arg form");
+ set S0, "Barbarian"
+ set S1, "ar"
+ index I1, S0, S1, 0
+ print I1
+ print "\n"
+
+ index I1, S0, S1, 2
+ print I1
+ print "\n"
+
+ set S1, "qwx"
+ index I1, S0, S1, 0
+ print I1
+ print "\n"
+
+ end
+CODE
+1
+4
+-1
+OUTPUT
+
+output_is(<<'CODE',<<OUTPUT,"index, null strings");
+ set S0, "Parrot"
+ set S1, ""
+ index I1, S0, S1
+ print I1
+ print "\n"
+
+ index I1, S0, S1, 0
+ print I1
+ print "\n"
+
+ index I1, S0, S1, 5
+ print I1
+ print "\n"
+
+ index I1, S0, S1, 6
+ print I1
+ print "\n"
+
+ set S0, ""
+ set S1, "a"
+ index I1, S0, S1
+ print I1
+ print "\n"
+
+ index I1, S0, S1, 0
+ print I1
+ print "\n"
+
+ end
+CODE
+-1
+-1
+-1
+-1
+-1
+-1
+OUTPUT
+
+output_is(<<'CODE',<<OUTPUT,"index, embedded nulls");
+ set S0, "Par\0\0rot"
+ set S1, "\0"
+ index I1, S0, S1
+ print I1
+ print "\n"
+
+ index I1, S0, S1, 4
+ print I1
+ print "\n"
+
+ end
+CODE
+3
+4
+OUTPUT
+
+output_is(<<'CODE',<<OUTPUT,"index, big strings");
+ set S0, "a"
+ repeat S0, S0, 10000
+ set S1, "a"
+ repeat S1, S1, 500
+ index I1, S0, S1
+ print I1
+ print "\n"
+
+ index I1, S0, S1, 1234
+ print I1
+ print "\n"
+
+ index I1, S0, S1, 9501
+ print I1
+ print "\n"
+
+ end
+CODE
+0
+1234
+-1
+OUTPUT
+
# Set all string registers to values given by &$_[0](reg num)
sub set_str_regs {
@@ -1076,3 +1203,4 @@
}
1;
+
--- t/op/stacks.t.old Fri May 31 17:35:50 2002
+++ t/op/stacks.t Fri May 31 17:48:31 2002
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 29;
+use Parrot::Test tests => 32;
use Test::More;
# Tests for stack operations, currently push*, push_*_c and pop*
@@ -589,6 +589,32 @@
OUTPUT
}
+output_is(<<'CODE', <<'OUTPUT', "depth op");
+ depth I0
+ print I0
+ print "\n"
+
+ save "Foo"
+ depth I0
+ print I0
+ print "\n"
+ restore S0
+
+ set I1, 0
+LOOP: save I1
+ inc I1
+ lt I1, 1024, LOOP
+ depth I0
+ print I0
+ print "\n"
+
+ end
+CODE
+0
+1
+1024
+OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "intstack");
intsave -1
intsave 0
@@ -622,6 +648,52 @@
43210-1
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "intstack stress test");
+ set I0, 0
+LOOP: intsave I0
+ inc I0
+ lt I0, 2048, LOOP
+
+LOOP2: dec I0
+ intrestore I1
+ ne I0, I1, ERROR
+ gt I0, 0, LOOP2
+ print "ok\n"
+ end
+
+ERROR: print "Not ok\n"
+ end
+
+CODE
+ok
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "intdepth");
+ intdepth I0
+ print I0
+ print "\n"
+
+ intsave 1
+ intdepth I0
+ print I0
+ print "\n"
+ intrestore I2
+
+ set I1, 0
+LOOP: intsave I1
+ inc I1
+ lt I1, 1024, LOOP
+ intdepth I0
+ print I0
+ print "\n"
+
+ end
+CODE
+0
+1
+1024
+OUTPUT
+
##############################
# set integer registers to some value given by $code...
