# 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...