cvsuser 01/09/24 10:19:48
Modified: . build_interp_starter.pl interpreter.c string.c
Parrot Test.pm
include/parrot exceptions.h interpreter.h
t/op string.t
Log:
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
Courtesy of: Alex Gough <[EMAIL PROTECTED]>
Revision Changes Path
1.12 +3 -3 parrot/build_interp_starter.pl
Index: build_interp_starter.pl
===================================================================
RCS file: /home/perlcvs/parrot/build_interp_starter.pl,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- build_interp_starter.pl 2001/09/19 20:05:06 1.11
+++ build_interp_starter.pl 2001/09/24 17:19:47 1.12
@@ -21,7 +21,7 @@
my $opcode_fingerprint = Parrot::Opcode::fingerprint();
for my $name (sort {$opcodes{$a}{CODE} <=> $opcodes{$b}{CODE}} keys %opcodes) {
- print INTERP "\tx[$opcodes{$name}{CODE}] = (void*)$name; \\\n";
+ print INTERP "\tx[$opcodes{$name}{CODE}] = $name; \\\n";
}
print INTERP "} while (0);\n";
@@ -61,8 +61,8 @@
print INTERP <<EOI;
#define DO_OP(w,x,y,z) do { \\
- x = (void *)z->opcode_funcs; \\
- y = (opcode_t* (*)())x[*w]; \\
+ x = z->opcode_funcs; \\
+ y = x[*w]; \\
w = (y)(w,z); \\
} while (0);
EOI
1.19 +6 -6 parrot/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /home/perlcvs/parrot/interpreter.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- interpreter.c 2001/09/19 20:05:06 1.18
+++ interpreter.c 2001/09/24 17:19:47 1.19
@@ -1,7 +1,7 @@
/* interpreter.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: interpreter.c,v 1.18 2001/09/19 20:05:06 thgibbs Exp $
+ * $Id: interpreter.c,v 1.19 2001/09/24 17:19:47 simon Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -49,7 +49,7 @@
/* Move these out of the inner loop. No need to redeclare 'em each
time through */
opcode_t *(*func)();
- void **temp;
+ opcode_t *(**temp)();
opcode_t *code_start;
code_start = code;
@@ -96,7 +96,7 @@
/* Move these out of the inner loop. No need to redeclare 'em each
time through */
opcode_t *(*func)();
- void **temp;
+ opcode_t *(**temp)();
opcode_t *code_start;
code_start = code;
@@ -213,7 +213,7 @@
/* The default opcode function table would be a good thing here... */
{
- void **foo;
+ opcode_t *(**foo)();
foo = mem_sys_allocate(2048 * sizeof(void *));
BUILD_TABLE(foo);
1.9 +14 -2 parrot/string.c
Index: string.c
===================================================================
RCS file: /home/perlcvs/parrot/string.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- string.c 2001/09/17 12:23:16 1.8
+++ string.c 2001/09/24 17:19:47 1.9
@@ -1,7 +1,7 @@
/* string.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: string.c,v 1.8 2001/09/17 12:23:16 thgibbs Exp $
+ * $Id: string.c,v 1.9 2001/09/24 17:19:47 simon Exp $
* Overview:
* This is the api definitions for the string subsystem
* Data Structure and Algorithms:
@@ -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:
*/
+
+
+
+
+
1.4 +4 -2 parrot/Parrot/Test.pm
Index: Test.pm
===================================================================
RCS file: /home/perlcvs/parrot/Parrot/Test.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- Test.pm 2001/09/21 20:24:01 1.3
+++ Test.pm 2001/09/24 17:19:48 1.4
@@ -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;
+
+
1.2 +2 -1 parrot/include/parrot/exceptions.h
Index: exceptions.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/exceptions.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- exceptions.h 2001/09/18 01:16:59 1.1
+++ exceptions.h 2001/09/24 17:19:48 1.2
@@ -1,7 +1,7 @@
/* exceptions.h
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: exceptions.h,v 1.1 2001/09/18 01:16:59 gregor Exp $
+ * $Id: exceptions.h,v 1.2 2001/09/24 17:19:48 simon Exp $
* Overview:
* define the internal interpreter exceptions
* Data Structure and Algorithms:
@@ -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
1.4 +3 -4 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/interpreter.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- interpreter.h 2001/09/19 20:04:45 1.3
+++ interpreter.h 2001/09/24 17:19:48 1.4
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: interpreter.h,v 1.3 2001/09/19 20:04:45 thgibbs Exp $
+ * $Id: interpreter.h,v 1.4 2001/09/24 17:19:48 simon Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -30,9 +30,8 @@
/* variable area */
struct Arenas *arena_base; /* Pointer to this */
/* interpreter's arena */
- opcode_t *(*(*opcode_funcs)[2048])(); /* Opcode */
- /* function table */
- STRING_FUNCS *(*(*string_funcs)[64])(); /* String function table */
+ opcode_t *(**opcode_funcs)(); /* Opcode function table */
+ STRING_FUNCS *(**string_funcs)(); /* String function table */
IV flags; /* Various interpreter flags
that signal that runops
should do something */
1.4 +63 -4 parrot/t/op/string.t
Index: string.t
===================================================================
RCS file: /home/perlcvs/parrot/t/op/string.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- string.t 2001/09/18 12:58:39 1.3
+++ string.t 2001/09/24 17:19:48 1.4
@@ -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"
