Author: leo
Date: Sun May 8 02:27:35 2005
New Revision: 8007
Modified:
trunk/ast/ast_main.c
trunk/build_tools/build_nativecall.pl
trunk/dynclasses/README
trunk/imcc/t/syn/pcc.t
trunk/lib/Parrot/Test.pm
Log:
make testr
[ run make testr in two steps ]
Courtey of Dino Morelli <[EMAIL PROTECTED]>
---
* revert %seen hash because of warnings
* emit to PBC if compiling PAST
* adjust pragma test to get one or two ok's
Modified: trunk/ast/ast_main.c
==============================================================================
--- trunk/ast/ast_main.c (original)
+++ trunk/ast/ast_main.c Sun May 8 02:27:35 2005
@@ -72,6 +72,7 @@
IMCC_free_nodes(interp, top_node);
}
+ emit_open(interp, 1, NULL);
imc_compile_all_units_for_ast(interp);
imc_compile_all_units(interp);
Modified: trunk/build_tools/build_nativecall.pl
==============================================================================
--- trunk/build_tools/build_nativecall.pl (original)
+++ trunk/build_tools/build_nativecall.pl Sun May 8 02:27:35 2005
@@ -185,7 +185,7 @@
my @extra_preamble;
my @extra_postamble;
my ($ret, $args) = split /\s+/, $_;
- next if $seen{"$ret$;$args"}++;
+ ## next if $seen{"$ret$;$args"}++;
my @arg;
my %reg_count;
@reg_count{qw(p i s n)} = (5, 5, 5, 5);
Modified: trunk/dynclasses/README
==============================================================================
--- trunk/dynclasses/README (original)
+++ trunk/dynclasses/README Sun May 8 02:27:35 2005
@@ -11,7 +11,7 @@
=item 1
-Edit/create your foo.pmc source - For details on creating PMCs, see
+Edit/create your foo.pmc source - For details on creating PMCs, see
L<../classes/genclass.pl>
There are some differences you have to be aware of when creating dynamic PMCs.
@@ -30,13 +30,19 @@
if (type == enum_class_String) { ...
-a dynamic PMC such as C<TclObject> must instead perform a runtime lookup
+a dynamic PMC such as C<TclInt> must instead perform a runtime lookup
of its corresponding C<TclString> PMC, resulting in the more complicated:
- if (type == pmc_type(
- interpreter,
- string_from_cstring(interpreter, "TclString", 9))
- )
+ static INTVAL dynclass_TclString;
+
+ pmclass TclInt extends TclObject extends Integer dynpmc group tcl_group {
+
+ void class_init() {
+ if (pass) {
+ dynclass_TclString = Parrot_PMC_typenum(INTERP,"TclString");
+ }
+ }
+ }
Finally, if you have a group of PMCs that are interdependent, use the
C<group GROUPNAME> syntax to trigger a group library to be built. You
@@ -51,30 +57,15 @@
=item 2
-Edit C<../config/gen/makefiles/dynclasses.in> and append your PMC(s) to
-the build target:
+Edit C<../config/gen/makefiles/dynclasses.in> and append your PMC(s) to
+the build target and:
$ make
- $ make shared
- $ cd dynclasses; make
=item 3
-Try the sample dynamic class, Foo. Note that the numbers listed here will
-change over time.
-
- $ ./parrot dynclasses/dynfoo.pasm
- ok 1
- 41
- ok 2
- 42
-
-=item 4
-
-There are two other similar test files: dynmatch.pasm and dyntcl.pasm.
-They do pretty much the same thing as dynfoo, but they load in PMC
-group libraries instead of a standalone PMC library.
-
If anything changes inside parrot, be sure to:
- $ cd dynclasses; make clean
+ $ make dynclasses-clean
+
+=back
Modified: trunk/imcc/t/syn/pcc.t
==============================================================================
--- trunk/imcc/t/syn/pcc.t (original)
+++ trunk/imcc/t/syn/pcc.t Sun May 8 02:27:35 2005
@@ -1238,20 +1238,17 @@
ok
OUT
-{
# The result of the code should depend on whether we run parrot with the
# "-o code.pbc -r -r" command line params.
# Strangely, the same output is written
- my $output = ($ENV{TEST_PROG_ARGS} || '') =~ m/-r / ?
- qq{ok\n} :
- qq{ok\n};
- pir_output_is(<<'CODE', $output, "more pragmas, syntax only");
+pir_output_like(<<'CODE', <<'OUT', "more pragmas, syntax only");
.sub _main prototyped, @MAIN, @LOAD, @POSTCOMP
print "ok\n"
end
.end
CODE
-}
+/(ok\n){1,2}/
+OUT
pir_output_is(<<'CODE', <<'OUT', "_func() syntax");
.sub test @MAIN
Modified: trunk/lib/Parrot/Test.pm
==============================================================================
--- trunk/lib/Parrot/Test.pm (original)
+++ trunk/lib/Parrot/Test.pm Sun May 8 02:27:35 2005
@@ -211,17 +211,26 @@
open STDOUT, ">$out" or die "Can't redirect stdout to $out" if $out;
open STDERR, ">$err" or die "Can't redirect stderr to $err" if $err;
- $command = "$ENV{VALGRIND} $command" if defined $ENV{VALGRIND};
+ # If $command isn't already an arrayref (because of a multi-command
+ # test), make it so now so the code below can treat everybody the
+ # same.
+ $command = [$command] unless (ref $command);
+
+ if (defined $ENV{VALGRIND}) {
+ $_ = "$ENV{VALGRIND} $_" for (@$command);
+ }
my $orig_dir;
if( $chdir ) {
- $orig_dir = cwd;
- chdir $chdir;
+ $orig_dir = cwd;
+ chdir $chdir;
}
- system( $command );
+
+ # Execute all commands
+ system $_ for (@$command);
if( $chdir ) {
- chdir $orig_dir;
+ chdir $orig_dir;
}
my $exit_code = $? >> 8;
@@ -380,11 +389,20 @@
if ( $func !~ /^pir_2_pasm_/ &&
( $args =~ s/--run-pbc// || $args =~ s/-r //) ) {
my $pbc_f = per_test('.pbc', $test_no);
- $args = qq{$args -o "$pbc_f" -r -r};
+ $args = qq{$args -o "$pbc_f"};
+
+ # In this case, we need to execute more than one
+ # command. Instead of a single scalar, build an
+ # array of commands.
+ $cmd = [
+ qq{$parrot $args "$code_f"},
+ qq{$parrot "$pbc_f"},
+ ];
+ } else {
+ $cmd = qq{$parrot $args "$code_f"};
}
- $cmd = qq{$parrot $args "$code_f"};
$exit_code = run_command($cmd, CD => $path_to_parrot,
- STDOUT => $out_f, STDERR => $out_f);
+ STDOUT => $out_f, STDERR => $out_f);
}
my $meth = $parrot_test_map{$func};
