I wrote some tests today...
1) captured error output, so can test errors, this might be bad, not sure.
2) basic tests for register stack frames, including some errors
3) I think we can stop skipping one of the string tests
4) I added some more substr tests, but substr was broken, so
5) changed substr to work with out of range values, or
6) throw an error if they're far too silly
Is that the right way to throw an error?
If so, should it have a different number?
Is it even worth testing error conditions yet (ie. are the error
messages fixed enough, will I8N rear its beautiful head)?
This is all done against a snapshot from a few hours ago and is one
big patch as $hacking_machine isn't talking to the internet until next
week...
Alex Gough
--
If history repeats itself, and the unexpected always happens,
how incapable must Man be of learning from experience!
diff -urN pclean/parrot/Parrot/Test.pm parrot/Parrot/Test.pm
--- pclean/parrot/Parrot/Test.pm Sat Sep 22 02:00:04 2001
+++ parrot/Parrot/Test.pm Sat Sep 22 22:19:25 2001
@@ -9,7 +9,7 @@
require Exporter;
require Test::More;
-@EXPORT = ( qw(output_is), @Test::More::EXPORT );
+@EXPORT = ( qw(output_is output_like output_isnt), @Test::More::EXPORT );
@ISA = qw(Exporter Test::More);
sub import {
@@ -59,7 +59,7 @@
close ASSEMBLY;
_run_command( "$PConfig{perl} assemble.pl $as_f --output $by_f" );
- _run_command( "./test_prog $by_f", 'STDOUT' => $out_f );
+ _run_command( "./test_prog $by_f", 'STDOUT' => $out_f, 'STDERR' => $out_f);
my $prog_output;
open OUTPUT, "< $out_f";
@@ -77,4 +77,6 @@
}
1;
+
+
diff -urN pclean/parrot/include/parrot/exceptions.h parrot/include/parrot/exceptions.h
--- pclean/parrot/include/parrot/exceptions.h Tue Sep 18 02:16:59 2001
+++ parrot/include/parrot/exceptions.h Sat Sep 22 22:59:31 2001
@@ -16,6 +16,7 @@
#define INTERNAL_EXCEPTION(x,y) {fprintf(stderr, y); exit(x);}
#define NO_REG_FRAMES 1
+#define SUBSTR_OUT_OF_STRING 1
#endif
diff -urN pclean/parrot/string.c parrot/string.c
--- pclean/parrot/string.c Mon Sep 17 14:00:01 2001
+++ parrot/string.c Sat Sep 22 23:14:56 2001
@@ -114,11 +114,18 @@
string_substr(STRING* src, IV offset, IV length, STRING** d) {
STRING *dest;
if (offset < 0) {
- offset = src->strlen - offset;
+ offset = src->strlen + offset;
+ }
+ if (offset < 0 || offset > src->strlen-1) { /* 0 based... */
+ INTERNAL_EXCEPTION(SUBSTR_OUT_OF_STRING,
+ "Cannot take substr outside string")
}
if (length < 0) {
length = 0;
}
+ if (length > (src->strlen - offset) ) {
+ length = src->strlen - offset;
+ }
if (!d || !*d) {
dest = string_make(NULL, 0, src->encoding->which, 0, 0);
}
@@ -148,3 +155,8 @@
*
* vim: expandtab shiftwidth=4:
*/
+
+
+
+
+
diff -urN pclean/parrot/t/op/stacks.t parrot/t/op/stacks.t
--- pclean/parrot/t/op/stacks.t Thu Jan 1 01:00:00 1970
+++ parrot/t/op/stacks.t Sat Sep 22 23:01:14 2001
@@ -0,0 +1,228 @@
+#! perl -w
+
+# Tests for stack operations, currently push_*, push_*_c and pop_*
+# where * != p.
+
+# Assembler code is partially generated by subs at bottom of file
+
+# Still to write: tests for (push|pop)_p(_c)?
+# tests for warp, unwarp and set_warp
+
+use Parrot::Test tests => 9;
+
+output_is( <<"CODE", <<'OUTPUT', "push_i & pop_i" );
+@{[ set_int_regs( sub { $_[0]} )]}
+ push_i
+@{[ set_int_regs( sub {-$_[0]} )]}
+@{[ print_int_regs() ]}
+ pop_i
+@{[ print_int_regs() ]}
+ end
+CODE
+0-1-2-3-4
+-5-6-7-8-9
+-10-11-12-13-14
+-15-16-17-18-19
+-20-21-22-23-24
+-25-26-27-28-29
+-30-31
+01234
+56789
+1011121314
+1516171819
+2021222324
+2526272829
+3031
+OUTPUT
+
+SKIP: {skip("push_i_c not implemented",1);
+output_is(<<"CODE", <<'OUTPUT', "push_i_c & pop_i");
+@{[ set_int_regs( sub {$_[0]}) ]}
+ push_i_c
+@{[ print_int_regs() ]}
+@{[ set_int_regs( sub {-$_[0]}) ]}
+@{[ print_int_regs() ]}
+ pop_i
+@{[ print_int_regs() ]}
+CODE
+01234
+56789
+1011121314
+1516171819
+2021222324
+2526272829
+3031
+0-1-2-3-4
+-5-6-7-8-9
+-10-11-12-13-14
+-15-16-17-18-19
+-20-21-22-23-24
+-25-26-27-28-29
+-30-31
+01234
+56789
+1011121314
+1516171819
+2021222324
+2526272829
+3031
+OUTPUT
+}
+
+output_is(<<"CODE", <<'OUTPUT', 'push_s & pop_s');
+@{[ set_str_regs( sub {$_[0]%2} ) ]}
+ push_s
+@{[ set_str_regs( sub {($_[0]+1) %2} ) ]}
+@{[ print_str_regs() ]}
+ print "\\n"
+ pop_s
+@{[ print_str_regs() ]}
+ print "\\n"
+ end
+CODE
+10101010101010101010101010101010
+01010101010101010101010101010101
+OUTPUT
+
+SKIP: {skip("push_s_c not implemented", 1);
+output_is(<<"CODE", <<'OUTPUT', 'push_s_c & pop_s');
+@{[ set_str_regs( sub {$_[0]%2} ) ]}
+ push_s_c
+@{[ print_str_regs() ]}
+ print "\\n"
+@{[ set_str_regs( sub {($_[0]+1) %2} ) ]}
+@{[ print_str_regs() ]}
+ print "\\n"
+ pop_s
+@{[ print_str_regs() ]}
+ print "\\n"
+ end
+CODE
+01010101010101010101010101010101
+10101010101010101010101010101010
+01010101010101010101010101010101
+OUTPUT
+}
+
+output_is(<<"CODE", <<'OUTPUT', 'push_n & pop_n');
+@{[ set_num_regs( sub { "1.0".$_ } ) ]}
+ push_n
+@{[ set_num_regs( sub { "-1.0".$_} ) ]}
+@{[ clt_num_regs() ]}
+ print "Seem to have negative Nx\\n"
+ pop_n
+@{[ cgt_num_regs() ]}
+ print "Seem to have positive Nx after pop\\n"
+ branch ALLOK
+ERROR: print "not ok\\n"
+ALLOK: end
+CODE
+Seem to have negative Nx
+Seem to have positive Nx after pop
+OUTPUT
+
+SKIP: { skip("push_n_c not yet implemented",1);
+output_is(<<"CODE", <<'OUTPUT', 'push_n_c & pop_n');
+@{[ set_num_regs( sub { "1.0".$_ } ) ]}
+ push_n_c
+@{[ cgt_num_regs() ]}
+ print "Seem to have positive Nx before push\\n"
+@{[ set_num_regs( sub { "-1.0".$_} ) ]}
+@{[ clt_num_regs() ]}
+ print "Seem to have negative Nx\\n"
+ pop_n
+@{[ cgt_num_regs() ]}
+ print "Seem to have positive Nx after pop\\n"
+ branch ALLOK
+ERROR: print "not ok\\n"
+ALLOK: end
+CODE
+Seem to have positive Nx before push
+Seem to have negative Nx
+Seem to have positive Nx after pop
+OUTPUT
+}
+
+# Now, to make it do BAD THINGS!
+output_is(<<"CODE",'No more I register frames to pop!','ENO I frames');
+ pop_i
+ end
+CODE
+output_is(<<"CODE",'No more N register frames to pop!','ENO N frames');
+ pop_n
+ end
+CODE
+output_is(<<"CODE",'No more S register frames to pop!','ENO S frames');
+ pop_s
+ end
+CODE
+
+# I'm lazy, and 32* as much code as needed isn't needed,
+# if you follow...
+
+# set integer registers to some value given by $code...
+package main;
+sub set_int_regs {
+ my $code = shift;
+ my $rt;
+ for (0..31) {
+ $rt .= "\tset I$_, ".&$code($_)."\n";
+ }
+ return $rt;
+}
+# print all integer registers, with newlines every five registers
+sub print_int_regs {
+ my ($rt, $foo);
+ for (0..31) {
+ $rt .= "\tprint I$_\n";
+ $rt .= "\tprint \"\\n\"\n" unless ++$foo % 5;
+ }
+ $rt .= "\tprint \"\\n\"\n";
+ return $rt;
+}
+
+# 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;
+}
+
+# Set "float" registers, &$_[0](reg num) should return string
+sub set_num_regs {
+ my $code = shift;
+ my $rt;
+ for (0..31) {
+ $rt .= "\tset N$_, ".&$code($_[0])."\n";
+ }
+ return $rt;
+}
+# rather than printing all num regs, compare all ge 0
+# if any are less, jump to ERROR
+# sense of test may seem backwards, but isn't
+sub cgt_num_regs {
+ my $rt;
+ for (0..31) {
+ $rt .= "\tlt_nc_ic N$_, 0, ERROR\n";
+ }
+ return $rt;
+}
+# same, but this time lt 0
+sub clt_num_regs {
+ my $rt;
+ for (0..31) {
+ $rt .= "\tgt_nc_ic N$_, 0, ERROR\n";
+ }
+ return $rt;
+}
diff -urN pclean/parrot/t/op/string.t parrot/t/op/string.t
--- pclean/parrot/t/op/string.t Tue Sep 18 14:00:01 2001
+++ parrot/t/op/string.t Sat Sep 22 23:17:03 2001
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 5;
+use Parrot::Test tests => 9;
output_is( <<'CODE', <<OUTPUT, "set_s_sc" );
set S4, "JAPH\n"
@@ -35,8 +35,6 @@
japh
OUTPUT
-SKIP: {
- skip "I'm unable to write it!", 1;
output_is( <<'CODE', 'JAPH', "substr_s_s_i_i" );
set S4, "12345JAPH01"
set I4, 5
@@ -45,7 +43,68 @@
print S5
end
CODE
-}
+
+# negative offsets
+output_is(<<'CODE', <<'OUTPUT', "neg substr offset");
+ set S0, "A string of length 21"
+ set I0, -9
+ set I1, 6
+ substr_s_s_i S1, S0, I0, I1
+ print S0
+ print "\n"
+ print S1
+ print "\n"
+ end
+CODE
+A string of length 21
+length
+OUTPUT
+
+# This asks for substring it shouldn't be allowed...
+output_is(<<'CODE', 'Cannot take substr outside string', "sub err:OOR");
+ set S0, "A string of length 21"
+ set I0, -99
+ set I1, 6
+ substr_s_s_i S1, S0, I0, I1
+ print S0
+ print "\n"
+ print S1
+ print "\n"
+ end
+CODE
+
+# This asks for substring much greater than length of original string
+output_is(<<'CODE', <<'OUTPUT', "len>strlen");
+ set S0, "A string of length 21"
+ set I0, 12
+ set I1, 1000
+ substr_s_s_i S1, S0, I0, I1
+ print S0
+ print "\n"
+ print S1
+ print "\n"
+ end
+CODE
+A string of length 21
+length 21
+OUTPUT
+
+# The same, with a negative offset
+output_is(<<'CODE', <<'OUTPUT', "len>strlen, -ve os");
+ set S0, "A string of length 21"
+ set I0, -9
+ set I1, 1000
+ substr_s_s_i S1, S0, I0, I1
+ print S0
+ print "\n"
+ print S1
+ print "\n"
+ end
+CODE
+A string of length 21
+length 21
+OUTPUT
+
output_is( <<'CODE', <<OUTPUT, "concat" );
set S1, "fish"
