cvs -q diff -u Index: languages/m4/ChangeLog =================================================================== RCS file: /cvs/public/parrot/languages/m4/ChangeLog,v retrieving revision 1.5 diff -u -u -r1.5 ChangeLog --- languages/m4/ChangeLog 10 Jul 2004 07:13:48 -0000 1.5 +++ languages/m4/ChangeLog 21 Sep 2004 22:02:35 -0000 @@ -1,5 +1,25 @@ # $Id: ChangeLog,v 1.5 2004/07/10 07:13:48 leo Exp $ +2004-09-20 Bernhard Schmalhofer + * Play again with 'm4_eval_compiler' + +2004-08-09 Bernhard Schmalhofer + * Fix failing test basic/012_eval.t + +2004-07-06 Bernhard Schmalhofer + * Make tests work again + * add some tests for 'eval' + * yank it up to revision 0.0.7 + +2004-06-27 Andy Dougherty + * Build patches for Solaris, RT#30320 + +2004-06-21 Bernhard Schmalhofer + * Don't write test files into '/tmp' + +2004-06-10 Bernhard Schmalhofer + * The symbolic link 'blib' isn't needed any more + 2004-07-06 Bernhard Schmalhofer * Make tests work again * add some tests for 'eval' Index: languages/m4/examples/eval.imc =================================================================== RCS file: /cvs/public/parrot/languages/m4/examples/eval.imc,v retrieving revision 1.2 diff -u -u -r1.2 eval.imc --- languages/m4/examples/eval.imc 10 Jul 2004 07:13:55 -0000 1.2 +++ languages/m4/examples/eval.imc 21 Sep 2004 22:02:35 -0000 @@ -17,21 +17,29 @@ # load shared lib # There is a init-function in the shared lib, # which registers the new compiler + print "Loading shared library, let the library register the compiler\n" .local pmc m4_eval_compiler_lib m4_eval_compiler_lib = loadlib "m4_eval_compiler" # get compiler - compreg P1, "m4_eval_compiler" + print "Getting the compiler\n" + .local pmc m4_eval_compiler + m4_eval_compiler = compreg "m4_eval_compiler" # compile code and run it - .local string code - code = '1' + .local string expression + expression = '1 + 1 * 117' + print "Evaluating expression: " + print expression + print "\n" .local pmc compiled_code - compiled_code = compile P1, code - .local pmc evaled_code - P16 = new PerlString - invoke compiled_code - print P16 - print "\ninvoked compiled code\n" + compiled_code = compile m4_eval_compiler, expression + + print "Invoking compiled code, and receive returned expression\n" + .local int evaluated_expression + ( evaluated_expression ) = compiled_code() + print "evaluated: " + print evaluated_expression + print "\n" end .end Index: languages/m4/src/builtin.imc =================================================================== RCS file: /cvs/public/parrot/languages/m4/src/builtin.imc,v retrieving revision 1.5 diff -u -u -r1.5 builtin.imc --- languages/m4/src/builtin.imc 10 Jul 2004 07:13:58 -0000 1.5 +++ languages/m4/src/builtin.imc 21 Sep 2004 22:02:35 -0000 @@ -497,7 +497,7 @@ =head2 _m4_eval -Frontend for printf like formatting. +Integer arithmetics. =cut @@ -506,17 +506,18 @@ .param PerlArray arguments # get compiler - compreg P1, "m4_eval_compiler" + .local pmc m4_eval_compiler + m4_eval_compiler = compreg "m4_eval_compiler" # compile code and run it - .local string code - code = arguments[0] + .local string expression + expression = arguments[0] .local pmc compiled_code - compiled_code = compile P1, code - P16 = new PerlString - invoke compiled_code + compiled_code = compile m4_eval_compiler, expression + .local int evaluated_expression + ( evaluated_expression ) = compiled_code() .local string ret - ret = P16 + ret = evaluated_expression .pcc_begin_return .return ret .pcc_end_return Index: languages/m4/src/eval.c =================================================================== RCS file: /cvs/public/parrot/languages/m4/src/eval.c,v retrieving revision 1.3 diff -u -u -r1.3 eval.c --- languages/m4/src/eval.c 10 Jul 2004 07:13:58 -0000 1.3 +++ languages/m4/src/eval.c 21 Sep 2004 22:02:37 -0000 @@ -32,7 +32,8 @@ /* This file contains the functions to evaluate integer expressions for the "eval" macro. It is a little, fairly self-contained module, with its own scanner, and a recursive descent parser. The only entry point - is evaluate (). */ + is evaluate (). +*/ /* Evaluates token types. */ @@ -66,8 +67,8 @@ eval_error; +/* declarations */ static eval_error logical_or_term( eval_token, eval_t * ); - static eval_error logical_and_term( eval_token, eval_t * ); static eval_error or_term( eval_token, eval_t * ); static eval_error xor_term( eval_token, eval_t * ); @@ -81,6 +82,7 @@ static eval_error exp_term( eval_token, eval_t * ); static eval_error unary_term( eval_token, eval_t * ); static eval_error simple_term( eval_token, eval_t * ); +boolean evaluate (const char *, eval_t *); /*--------------------. | Lexical functions. | @@ -908,6 +910,9 @@ opcode_t* pc; + /* + * The real work is done here + */ evaluate( program, &value ); /* @@ -921,18 +926,37 @@ cur_cs->base.data = mem_sys_allocate(CODE_SIZE * sizeof(opcode_t)); cur_cs->base.size = CODE_SIZE; consts = cur_cs->consts; + /* - * now start compiling + * Generate some bytecode */ pc = cur_cs->base.data; - /* *pc++ = interpreter->op_lib->op_code("print_sc", 1); */ - /* *pc++ = add_const_str(interpreter, consts, "asdfasdf" ); */ - *pc++ = interpreter->op_lib->op_code("set_p_ic", 1); - *pc++ = 16; - *pc++ = value; - /* *pc++ = add_const_str(interpreter, consts, program ); */ - /* *pc++ = interpreter->op_lib->op_code("invoke_p", 1); */ - /* *pc++ = 1; */ + /* first integer return value */ + *pc++ = interpreter->op_lib->op_code("set_i_ic", 1); + *pc++ = 5; + *pc++ = value; + /* promise to fill in the counters */ + *pc++ = interpreter->op_lib->op_code("set_i_ic", 1); + *pc++ = 0; + *pc++ = 1; + /* one integer return value */ + *pc++ = interpreter->op_lib->op_code("set_i_ic", 1); + *pc++ = 1; + *pc++ = 1; + /* no string return values */ + *pc++ = interpreter->op_lib->op_code("set_i_ic", 1); + *pc++ = 2; + *pc++ = 0; + /* no PMC return values */ + *pc++ = interpreter->op_lib->op_code("set_i_ic", 1); + *pc++ = 3; + *pc++ = 0; + /* no numeric return values */ + *pc++ = interpreter->op_lib->op_code("set_i_ic", 1); + *pc++ = 3; + *pc++ = 0; + /* do something else now */ + *pc++ = interpreter->op_lib->op_code("end", 1); return pf; } Index: languages/m4/src/m4.imc =================================================================== RCS file: /cvs/public/parrot/languages/m4/src/m4.imc,v retrieving revision 1.8 diff -u -u -r1.8 m4.imc --- languages/m4/src/m4.imc 10 Jul 2004 07:13:59 -0000 1.8 +++ languages/m4/src/m4.imc 21 Sep 2004 22:02:38 -0000 @@ -87,7 +87,7 @@ # Was '--version' passed ? is_defined = defined opt["version"] unless is_defined goto NO_VERSION_FLAG - print "Parrot m4 0.0.7\n" + print "Parrot m4 0.0.8\n" end NO_VERSION_FLAG: Index: languages/m4/t/harness =================================================================== RCS file: /cvs/public/parrot/languages/m4/t/harness,v retrieving revision 1.2 diff -u -u -r1.2 harness --- languages/m4/t/harness 10 Jul 2004 07:14:07 -0000 1.2 +++ languages/m4/t/harness 21 Sep 2004 22:02:38 -0000 @@ -1,13 +1,5 @@ # $Id: harness,v 1.2 2004/07/10 07:14:07 leo Exp $ -# pragmata -use strict; - -use Test::Harness; -use File::Spec; - -my $language = 'm4'; - =head1 NAME languages/m4/t/harness - A harness for Parrot m4 @@ -22,7 +14,6 @@ m4/t/basic/006_define_with_rest \ m4/t/regex/003_two_compiles.t - =head1 DESCRIPTION Conformant to a recent post on p6i, if I'm called with a single @@ -35,6 +26,14 @@ =cut +# pragmata +use strict; + +use Test::Harness(); +use File::Spec; + +my $language = 'm4'; + if ( grep { m/^-files$/ } @ARGV ) { # Only the Makefile in 'parrot/languages' uses -file @@ -56,7 +55,7 @@ # Propably called out of 'parrot/languages' @files = glob( "m4/t/*/*.t" ); } - runtests( @files ) if scalar(@files); + Test::Harness::runtests( @files ) if scalar(@files); } =head1 HISTORY Index: languages/m4/t/basic/003_getopt.t =================================================================== RCS file: /cvs/public/parrot/languages/m4/t/basic/003_getopt.t,v retrieving revision 1.6 diff -u -u -r1.6 003_getopt.t --- languages/m4/t/basic/003_getopt.t 10 Jul 2004 07:14:02 -0000 1.6 +++ languages/m4/t/basic/003_getopt.t 21 Sep 2004 22:02:39 -0000 @@ -31,7 +31,7 @@ #-------------------------------------------- $real_out = `$parrot_m4 --version 2>&1`; is( $real_out, << 'END_OUT', '--version' ); -Parrot m4 0.0.7 +Parrot m4 0.0.8 END_OUT Index: languages/m4/t/basic/012_eval.t =================================================================== RCS file: /cvs/public/parrot/languages/m4/t/basic/012_eval.t,v retrieving revision 1.3 diff -u -u -r1.3 012_eval.t --- languages/m4/t/basic/012_eval.t 10 Jul 2004 07:14:02 -0000 1.3 +++ languages/m4/t/basic/012_eval.t 21 Sep 2004 22:02:39 -0000 @@ -8,7 +8,10 @@ my $parrot = 'cd .. && ./parrot'; $real_out = `$parrot languages/m4/examples/eval.imc 2>&1`; -is( $real_out, << 'END_OUT', 'single file' ); -1 -invoked compiled code +is( $real_out, << 'END_OUT', 'single expression' ); +Loading shared library, let the library register the compiler +Getting the compiler +Evaluating expression: 1 + 1 * 117 +Invoking compiled code, and receive returned expression +evaluated: 118 END_OUT Index: languages/m4/t/builtins/011_eval.t =================================================================== RCS file: /cvs/public/parrot/languages/m4/t/builtins/011_eval.t,v retrieving revision 1.3 diff -u -u -r1.3 011_eval.t --- languages/m4/t/builtins/011_eval.t 10 Jul 2004 07:14:05 -0000 1.3 +++ languages/m4/t/builtins/011_eval.t 21 Sep 2004 22:02:39 -0000 @@ -2,7 +2,7 @@ use strict; -use Parrot::Test tests => 2; +use Parrot::Test tests => 3; # Test the m4-Builtin function 'eval' @@ -89,3 +89,19 @@ OUT } + +{ + language_output_is( 'm4', <<'CODE', <<'OUT', 'bitwise ops' ); +1 eval( `1 | 2') bitwise OR +2 eval( `1 | 3') bitwise OR +3 eval( `4 & 5') bitwise AND +4 eval( `4 ^ 5') bitwise XOR +5 eval( `~ 254') bitwise negation +CODE +1 3 bitwise OR +2 3 bitwise OR +3 4 bitwise AND +4 1 bitwise XOR +5 -255 bitwise negation +OUT +} Index: lib/Parrot/Test/m4.pm =================================================================== RCS file: /cvs/public/parrot/lib/Parrot/Test/m4.pm,v retrieving revision 1.3 diff -u -u -r1.3 m4.pm --- lib/Parrot/Test/m4.pm 10 Jul 2004 07:14:13 -0000 1.3 +++ lib/Parrot/Test/m4.pm 21 Sep 2004 22:02:40 -0000 @@ -57,9 +57,9 @@ # TODO: Don't ignore STDERR my $exit_code = Parrot::Test::_run_command( $parrot_m4, STDOUT => $parrot_m4_out_f ); - $exit_code = Parrot::Test::_run_command( $gnu_m4, STDOUT => $gnu_m4_out_f ); + $exit_code = Parrot::Test::_run_command( $gnu_m4, STDOUT => $gnu_m4_out_f ); - my $pass = $self->{builder}->is_eq( Parrot::Test::slurp_file($parrot_m4_out_f) . Parrot::Test::slurp_file($parrot_m4_out_f), , $output . $output, $desc ); + my $pass = $self->{builder}->is_eq( Parrot::Test::slurp_file($parrot_m4_out_f) . Parrot::Test::slurp_file($gnu_m4_out_f), , $output . $output, $desc ); $self->{builder}->diag( "'$parrot_m4' failed with exit code $exit_code" ) if $exit_code and not $pass; # die Data::Dumper::Dumper( $lang_f, `pwd`, $parrot_m4, $parrotdir, $parrot_m4_out_f ); Index: runtime/parrot/library/Getopt/Long.imc =================================================================== RCS file: /cvs/public/parrot/runtime/parrot/library/Getopt/Long.imc,v retrieving revision 1.2 diff -u -u -r1.2 Long.imc --- runtime/parrot/library/Getopt/Long.imc 10 Jul 2004 07:14:15 -0000 1.2 +++ runtime/parrot/library/Getopt/Long.imc 21 Sep 2004 22:02:41 -0000 @@ -146,7 +146,7 @@ =head1 AUTHOR -Bernhard Schmalhofer +Bernhard Schmalhofer - L =head1 SEE ALSO