perl.cvs.parrot

perl.cvs.parrot http://www.nntp.perl.org/group/perl.cvs.parrot/ ... Copyright 1998-2008 perl.org Mon, 13 Oct 2008 13:26:48 +0000 ask@perl.org [svn:parrot] r31925 - in trunk/languages/pipp: src/pct t/php by bernhard Author: bernhard Date: Mon Oct 13 04:47:49 2008 New Revision: 31925 Modified: trunk/languages/pipp/src/pct/actions.pm trunk/languages/pipp/src/pct/grammar.pg trunk/languages/pipp/t/php/oo.t Log: [Pipp] Start to put member declaration into the symbol table. Modified: trunk/languages/pipp/src/pct/actions.pm ============================================================================== --- trunk/languages/pipp/src/pct/actions.pm (original) +++ trunk/languages/pipp/src/pct/actions.pm Mon Oct 13 04:47:49 2008 @@ -312,14 +312,6 @@ make $past; } -method member_definition($/) { - make PAST::Op.new( - $( $<var> ), - $( $<literal> ), - :pasttype('bind'), - ); -} - method method_definition($/) { # note that $<param_list> creates a new PAST::Block. @@ -372,6 +364,9 @@ := PAST::Block.new( :blocktype('immediate'), ); + for $<member_definition> { + $methods_block.symbol( ~$_<VAR_NAME><ident>, :scope('attribute') ); + } for $<method_definition> { $methods_block.push( $($_) ); } Modified: trunk/languages/pipp/src/pct/grammar.pg ============================================================================== --- trunk/languages/pipp/src/pct/grammar.pg (original) +++ trunk/languages/pipp/src/pct/grammar.pg Mon Oct 13 04:47:49 2008 @@ -117,7 +117,7 @@ rule function_definition { 'function' <FUNCTION_NAME> <param_list> <block> {*} } rule method_definition { 'function' <METHOD_NAME> <param_list> <block> {*} } rule param_list { '(' [ <VAR_NAME> [',' <VAR_NAME>]* ]? ')' {*} } -rule member_definition { 'public' <var> '=' <literal> <.statement_delimiter> {*} } +rule member_definition { 'public' <VAR_NAME> '=' <literal> <.statement_delimiter> {*} } rule class_definition { 'class' <CLASS_NAME> '{' <member_definition>* Modified: trunk/languages/pipp/t/php/oo.t ============================================================================== --- trunk/languages/pipp/t/php/oo.t (original) +++ trunk/languages/pipp/t/php/oo.t Mon Oct 13 04:47:49 2008 @@ -18,7 +18,7 @@ use lib "$FindBin::Bin/../../lib"; # core Perl modules -use Test::More tests => 3; +use Test::More tests => 4; # Parrot modules use Parrot::Test; @@ -40,7 +40,7 @@ After class definition. END_EXPECTED -language_output_is( 'Pipp', <<'END_CODE', <<'END_EXPECTED', 'dummy class' ); +language_output_is( 'Pipp', <<'END_CODE', <<'END_EXPECTED', 'calling a class method' ); <?php class Dings { @@ -58,6 +58,25 @@ The function bums() in class Dings has been called. END_EXPECTED +language_output_is( 'Pipp', <<'END_CODE', <<'END_EXPECTED', 'class with a public member' ); +<?php + +class Dings { + public $foo_member = 'a member of Foo'; + + function bums() { + echo "The function bums() in class Dings has been called.\n"; + } +} + +$dings = new Dings; +$dings->bums(); + +?> +END_CODE +The function bums() in class Dings has been called. +END_EXPECTED + language_output_is( 'Pipp', <<'END_CODE', <<'END_EXPECTED', 'using $this' ); <?php http://www.nntp.perl.org/group/perl.cvs.parrot/2008/10/msg32319.html Mon, 13 Oct 2008 04:47:58 +0000 [svn:parrot] r31924 - trunk/languages/pipp/src/pct by bernhard Author: bernhard Date: Mon Oct 13 04:14:02 2008 New Revision: 31924 Modified: trunk/languages/pipp/src/pct/actions.pm trunk/languages/pipp/src/pct/grammar.pg Log: [Pipp] Put class methods into an immediate block, as seen on Rakudo. Modified: trunk/languages/pipp/src/pct/actions.pm ============================================================================== --- trunk/languages/pipp/src/pct/actions.pm (original) +++ trunk/languages/pipp/src/pct/actions.pm Mon Oct 13 04:14:02 2008 @@ -357,10 +357,9 @@ method class_definition($/) { my $past := PAST::Block.new( :node($/), - :blocktype('declaration'), :namespace( $<CLASS_NAME><ident> ), + :blocktype('declaration'), :pirflags( ':init :load' ), - :lexical( 0 ), PAST::Stmts.new( PAST::Op.new( :inline( "$P0 = get_hll_global 'P6metaclass'\n" @@ -369,9 +368,14 @@ ) ) ); + my $methods_block + := PAST::Block.new( + :blocktype('immediate'), + ); for $<method_definition> { - $past.push( $($_) ); + $methods_block.push( $($_) ); } + $past.push( $methods_block ); make $past; } Modified: trunk/languages/pipp/src/pct/grammar.pg ============================================================================== --- trunk/languages/pipp/src/pct/grammar.pg (original) +++ trunk/languages/pipp/src/pct/grammar.pg Mon Oct 13 04:14:02 2008 @@ -74,7 +74,7 @@ token METHOD_NAME { <ident> } token CONSTANT_NAME { <ident> } token CLASS_NAME { <ident> } -token VAR_NAME { '$' <ident> {*} } +token VAR_NAME { '$' <ident> {*} } # terms rule method_call { <var> '->' <METHOD_NAME> '(' <arguments> ')' {*} } http://www.nntp.perl.org/group/perl.cvs.parrot/2008/10/msg32318.html Mon, 13 Oct 2008 04:14:13 +0000 [svn:parrot] r31923 - trunk/languages/pipp/src/pct by bernhard Author: bernhard Date: Mon Oct 13 03:45:09 2008 New Revision: 31923 Modified: trunk/languages/pipp/src/pct/grammar.pg Log: [Pipp] Paamayim Nekudotayim is not allowed in class names. Modified: trunk/languages/pipp/src/pct/grammar.pg ============================================================================== --- trunk/languages/pipp/src/pct/grammar.pg (original) +++ trunk/languages/pipp/src/pct/grammar.pg Mon Oct 13 03:45:09 2008 @@ -73,7 +73,7 @@ token FUNCTION_NAME { <ident> } token METHOD_NAME { <ident> } token CONSTANT_NAME { <ident> } -token CLASS_NAME { <ident> [ '::' <ident> ]* } +token CLASS_NAME { <ident> } token VAR_NAME { '$' <ident> {*} } # terms http://www.nntp.perl.org/group/perl.cvs.parrot/2008/10/msg32317.html Mon, 13 Oct 2008 03:45:21 +0000 [svn:parrot] r31922 - trunk/languages/pipp/t/php by bernhard Author: bernhard Date: Mon Oct 13 03:40:17 2008 New Revision: 31922 Modified: trunk/languages/pipp/t/php/oo.t Log: [Pipp] use correct class name in test case. Modified: trunk/languages/pipp/t/php/oo.t ============================================================================== --- trunk/languages/pipp/t/php/oo.t (original) +++ trunk/languages/pipp/t/php/oo.t Mon Oct 13 03:40:17 2008 @@ -29,7 +29,7 @@ class Dings { function bums() { - echo "The function bums() in class dings has been called.\n"; + echo "The function bums() in class Dings has been called.\n"; } } @@ -46,7 +46,7 @@ class Dings { function bums() { - echo "The function bums() in class dings has been called.\n"; + echo "The function bums() in class Dings has been called.\n"; } } @@ -55,7 +55,7 @@ ?> END_CODE -The function bums() in class dings has been called. +The function bums() in class Dings has been called. END_EXPECTED http://www.nntp.perl.org/group/perl.cvs.parrot/2008/10/msg32316.html Mon, 13 Oct 2008 03:40:28 +0000 [svn:parrot] r31921 - trunk/languages/pipp/src/pct by bernhard Author: bernhard Date: Mon Oct 13 03:32:03 2008 New Revision: 31921 Modified: trunk/languages/pipp/src/pct/actions.pm Log: [Pipp] Class names don't need to be split on '::'. Modified: trunk/languages/pipp/src/pct/actions.pm ============================================================================== --- trunk/languages/pipp/src/pct/actions.pm (original) +++ trunk/languages/pipp/src/pct/actions.pm Mon Oct 13 03:32:03 2008 @@ -363,9 +363,8 @@ :lexical( 0 ), PAST::Stmts.new( PAST::Op.new( - :inline( "$P0 = get_hll_global 'P6metaclass'\n $P1 = split '::', '" - ~ $<CLASS_NAME> - ~ "'\n push_eh subclass_done\n $P2 = $P0.'new_class'($P1)\n pop_eh\n subclass_done:\n" ), + :inline( "$P0 = get_hll_global 'P6metaclass'\n" + ~ "$P2 = $P0.'new_class'('" ~ $<CLASS_NAME> ~ "')\n" ), :pasttype( 'inline' ) ) ) http://www.nntp.perl.org/group/perl.cvs.parrot/2008/10/msg32315.html Mon, 13 Oct 2008 03:32:19 +0000 [svn:parrot] r31920 - trunk/languages/pipp/src/pct by bernhard Author: bernhard Date: Mon Oct 13 02:43:11 2008 New Revision: 31920 Modified: trunk/languages/pipp/src/pct/grammar.pg Log: [Pipp] write name of the proto regexes as identifiers, not as a string Modified: trunk/languages/pipp/src/pct/grammar.pg ============================================================================== --- trunk/languages/pipp/src/pct/grammar.pg (original) +++ trunk/languages/pipp/src/pct/grammar.pg Mon Oct 13 02:43:11 2008 @@ -130,32 +130,32 @@ # operator precedence table rule expression is optable { ... } -proto 'postfix:++' is precedence('1') { ... } -proto 'postfix:--' is equiv(postfix:<++>) { ... } -proto 'prefix:++' is equiv(postfix:<++>) { ... } -proto 'prefix:--' is equiv(postfix:<++>) { ... } - -proto 'infix:|' is looser('postfix:++') { ... } -proto 'infix:&' is equiv('infix:|') { ... } -proto 'infix:^' is equiv('infix:|') { ... } - -proto 'infix:<' is tighter('infix:|') { ... } -proto 'infix:<=' is equiv('infix:<') { ... } -proto 'infix:>' is equiv('infix:<') { ... } -proto 'infix:>=' is equiv('infix:<') { ... } -proto 'infix:==' is equiv('infix:<') { ... } -proto 'infix:!=' is equiv('infix:<') { ... } - -proto 'infix:+' is tighter('infix:<') { ... } -proto 'infix:-' is equiv('infix:+') { ... } -proto 'infix:.' is equiv('infix:+') is pirop('concat') { ... } - -proto 'infix:*' is tighter('infix:+') { ... } -proto 'infix:%' is equiv('infix:*') { ... } -proto 'infix:/' is equiv('infix:*') { ... } - -proto 'prefix:-' is tighter('infix:*') { ... } -proto 'prefix:+' is equiv('prefix:-') { ... } -proto 'prefix:!' is equiv('prefix:-') { ... } +proto postfix:'++' is precedence('1') { ... } +proto postfix:'--' is equiv(postfix:<++>) { ... } +proto prefix:'++' is equiv(postfix:<++>) { ... } +proto prefix:'--' is equiv(postfix:<++>) { ... } + +proto infix:'|' is looser('postfix:++') { ... } +proto infix:'&' is equiv('infix:|') { ... } +proto infix:'^' is equiv('infix:|') { ... } + +proto infix:'<' is tighter('infix:|') { ... } +proto infix:'<=' is equiv('infix:<') { ... } +proto infix:'>' is equiv('infix:<') { ... } +proto infix:'>=' is equiv('infix:<') { ... } +proto infix:'==' is equiv('infix:<') { ... } +proto infix:'!=' is equiv('infix:<') { ... } + +proto infix:'+' is tighter('infix:<') { ... } +proto infix:'-' is equiv('infix:+') { ... } +proto infix:'.' is equiv('infix:+') is pirop('concat') { ... } + +proto infix:'*' is tighter('infix:+') { ... } +proto infix:'%' is equiv('infix:*') { ... } +proto infix:'/' is equiv('infix:*') { ... } + +proto prefix:'-' is tighter('infix:*') { ... } +proto prefix:'+' is equiv('prefix:-') { ... } +proto prefix:'!' is equiv('prefix:-') { ... } -proto 'term:' is tighter('prefix:-') is parsed(&term) { ... } +proto term:'' is tighter('prefix:-') is parsed(&term) { ... } http://www.nntp.perl.org/group/perl.cvs.parrot/2008/10/msg32314.html Mon, 13 Oct 2008 02:43:23 +0000 [svn:parrot] r31919 - trunk/languages/lua/t by fperrad Author: fperrad Date: Mon Oct 13 00:03:52 2008 New Revision: 31919 Modified: trunk/languages/lua/t/test_lex.t Log: [Lua] - add conditional skip Modified: trunk/languages/lua/t/test_lex.t ============================================================================== --- trunk/languages/lua/t/test_lex.t (original) +++ trunk/languages/lua/t/test_lex.t Mon Oct 13 00:03:52 2008 @@ -25,8 +25,17 @@ use FindBin; use lib "$FindBin::Bin"; -use Parrot::Test tests => 23; +use Parrot::Test; use Test::More; +use Parrot::Test::Lua; + +my $test_prog = Parrot::Test::Lua::get_test_prog(); +if ( $test_prog eq 'lua' || $test_prog eq 'luac.pl' ) { + plan skip_all => "parrot only"; +} +else { + plan tests => 23; +} language_output_is( 'Lua_lex', <<'CODE', <<'OUT', 'hello' ); print("hello") http://www.nntp.perl.org/group/perl.cvs.parrot/2008/10/msg32313.html Mon, 13 Oct 2008 00:04:05 +0000 [svn:parrot] r31918 - in trunk/t: compilers/imcc/syn pmc src by chromatic Author: chromatic Date: Sun Oct 12 18:46:25 2008 New Revision: 31918 Modified: trunk/t/compilers/imcc/syn/file.t trunk/t/pmc/eval.t trunk/t/pmc/multidispatch.t trunk/t/pmc/sub.t trunk/t/pmc/sys.t trunk/t/src/extend.t Log: [t] Revised several tests to use unique temporary PIR, PASM, and PBC files. This avoids spurious and accidental race conditions which cause weird failures during parallel testing. Modified: trunk/t/compilers/imcc/syn/file.t ============================================================================== --- trunk/t/compilers/imcc/syn/file.t (original) +++ trunk/t/compilers/imcc/syn/file.t Sun Oct 12 18:46:25 2008 @@ -1,13 +1,18 @@ #!perl -# Copyright (C) 2001-2005, The Perl Foundation. +# Copyright (C) 2001-2008, The Perl Foundation. # $Id$ use strict; use warnings; use lib qw( . lib ../lib ../../lib ); + +use Cwd 'cwd'; + use File::Spec; use Test::More; -use Cwd qw(cwd); + +use File::Temp 'tempfile'; + use Parrot::Config; use Parrot::Test tests => 14; @@ -29,20 +34,19 @@ my $ended_ok = 0; -delete_temp_files(); -############################## -open my $FOO, '>', "temp.pasm" or die "Can't write temp.pasm\n"; +my ($FOO, $temp_pasm) = tempfile( SUFFIX => '.pasm', DIR => cwd() ); + print $FOO <<'ENDF'; .macro_const BAR 42 ENDF close $FOO; -pir_output_is( <<'CODE', <<'OUT', 'include pasm' ); +pir_output_is( <<"CODE", <<'OUT', 'include pasm' ); .sub test :main - print "before\n" - .include "temp.pasm" + say "before" + .include "$temp_pasm" print .BAR - print "\nafter\n" + say "\\nafter" end .end CODE @@ -50,20 +54,18 @@ 42 after OUT -unlink 'temp.pasm'; -############################## -open $FOO, '>', "temp.pasm" or die "Can't write temp.pasm\n"; +($FOO, $temp_pasm) = tempfile( SUFFIX => '.pasm' ); + print $FOO <<'ENDF'; .macro_const BAR 42 ENDF close $FOO; -my $temp_abs_path = cwd()."/temp.pasm"; pir_output_is( <<"CODE", <<'OUT', 'include pasm (absolute path)' ); .sub test :main say "before" - .include '$temp_abs_path' + .include '$temp_pasm' say .BAR say "after" end @@ -73,21 +75,20 @@ 42 after OUT -unlink 'temp.pasm'; -############################## -open $FOO, '>', 'temp.pir' or die "Can't write temp.pir: $!\n"; +($FOO, my $temp_pir) = tempfile( SUFFIX => '.pir' ); + print $FOO <<'ENDF'; .const int BAR = 42 ENDF close $FOO; -pir_output_is( <<'CODE', <<'OUT', 'include pir' ); +pir_output_is( <<"CODE", <<'OUT', 'include pir' ); .sub test :main - print "before\n" - .include "temp.pir" + say "before" + .include "$temp_pir" print BAR - print "\nafter\n" + say "\\nafter" end .end CODE @@ -95,21 +96,20 @@ 42 after OUT -unlink "temp.pir"; -############################## -open $FOO, '>', 'temp.inc' or die "Can't write temp.inc: $!\n"; +($FOO, my $temp_inc) = tempfile( SUFFIX => '.inc' ); + print $FOO <<'ENDF'; .const int BAR = 42 ENDF close $FOO; -pir_output_is( <<'CODE', <<'OUT', 'include temp.inc' ); +pir_output_is( <<"CODE", <<'OUT', 'include temp.inc' ); .sub test :main - print "before\n" - .include "temp.inc" + say "before" + .include "$temp_inc" print BAR - print "\nafter\n" + say "\\nafter" end .end CODE @@ -117,12 +117,10 @@ 42 after OUT -unlink "temp.inc"; -############################## -my $file = '_test.inc'; -open my $F, '>', $file or die "Can't create $file: $!\n"; -print $F <<'EOF'; +($FOO, $temp_inc) = tempfile( SUFFIX => '.inc' ); + +print $FOO <<'EOF'; .sub _foo # sub foo(int a, int b) .param int a .param int b @@ -139,9 +137,9 @@ .return (pl, mi) .end EOF -close $F; +close $FOO; -pir_output_is( <<'CODE', <<'OUT', 'subroutine in external file' ); +pir_output_is( <<"CODE", <<'OUT', 'subroutine in external file' ); .sub test :main .local int x x = 10 @@ -152,14 +150,12 @@ (r, s) = _foo(x,y) print "r = " - print r - print "\n" + say r print "s = " - print s - print "\n" + say s end .end -.include "_test.inc" +.include "$temp_inc" CODE a = 10 b = 20 @@ -170,27 +166,28 @@ # test load_bytecode branches and subs # write sub2 -open $FOO, '>', 'temp.pir' or die "Can't write temp.pir: $!\n"; +($FOO, $temp_pir) = tempfile( SUFFIX => '.pir' ); + print $FOO <<'ENDF'; .sub _sub2 - print "sub2\n" + say "sub2" end .end ENDF close $FOO; # compile it +(undef, my $temp_pbc) = tempfile( SUFFIX => '.pbc' ); +system_or_die( $PARROT, '-o', $temp_pbc, $temp_pir ); -system_or_die( $PARROT, qw( -o temp.pbc temp.pir ) ); - -pir_output_is( <<'CODE', <<'OUT', 'call sub in external pbc' ); +pir_output_is( <<"CODE", <<'OUT', 'call sub in external pbc' ); .sub _sub1 - print "sub1\n" - load_bytecode "temp.pbc" - print "loaded\n" - $P0 = global "_sub2" + say "sub1" + load_bytecode "$temp_pbc" + say "loaded" + \$P0 = global "_sub2" .begin_call - .call $P0 + .call \$P0 ret: .end_call end @@ -202,7 +199,9 @@ OUT # write sub2 -open $FOO, '>', 'temp.pir' or die "Can't write temp.pir: $!\n"; +($FOO, $temp_pir) = tempfile( SUFFIX => '.pir' ); +(undef, $temp_pbc) = tempfile( SUFFIX => '.pbc' ); + print $FOO <<'ENDF'; .sub _sub2 print "sub2\n" @@ -215,20 +214,19 @@ # compile it -unlink 'temp.pbc'; -system_or_die( $PARROT, qw( -o temp.pbc temp.pir ) ); +system_or_die( $PARROT, '-o', $temp_pbc, $temp_pir ); -pir_output_is( <<'CODE', <<'OUT', 'call sub in external pbc, return' ); +pir_output_is( <<"CODE", <<'OUT', 'call sub in external pbc, return' ); .sub _sub1 - print "sub1\n" - load_bytecode "temp.pbc" - print "loaded\n" - $P0 = global "_sub2" + say "sub1" + load_bytecode "$temp_pbc" + say "loaded" + \$P0 = global "_sub2" .begin_call - .call $P0 + .call \$P0 ret: .end_call - print "back\n" + say "back" end .end CODE @@ -239,33 +237,33 @@ OUT # write sub2 -open $FOO, '>', 'temp.pir' or die "Can't write temp.pir: $!\n"; +($FOO, $temp_pir) = tempfile( SUFFIX => '.pir' ); +(undef, $temp_pbc) = tempfile( SUFFIX => '.pbc' ); + print $FOO <<'ENDF'; .sub _not_sub2 - print "not sub2\n" + say "not sub2" end .end .sub _sub2 - print "sub2\n" + say "sub2" end .end ENDF close $FOO; # compile it +system($PARROT, '-o', $temp_pbc, $temp_pir); -unlink 'temp.pbc'; -system("$PARROT -o temp.pbc temp.pir"); - -pir_output_is( <<'CODE', <<'OUT', 'call sub in external pbc with 2 subs' ); +pir_output_is( <<"CODE", <<'OUT', 'call sub in external pbc with 2 subs' ); .sub _sub1 - print "sub1\n" - load_bytecode "temp.pbc" - print "loaded\n" - $P0 = global "_sub2" + say "sub1" + load_bytecode "$temp_pbc" + say "loaded" + \$P0 = global "_sub2" .begin_call - .call $P0 + .call \$P0 ret: .end_call end @@ -277,7 +275,7 @@ OUT # write sub2 -open $FOO, '>', "temp.pir" or die "Can't write temp.pir: $!\n"; +open $FOO, '>', "$temp_pir" or die "Can't write $temp_pir: $!\n"; print $FOO <<'ENDF'; .sub _sub2 print "sub2\n" @@ -290,17 +288,17 @@ # compile it -pir_output_is( <<'CODE', <<'OUT', 'call sub in external pir, return' ); +pir_output_is( <<"CODE", <<'OUT', 'call sub in external pir, return' ); .sub _sub1 - print "sub1\n" - load_bytecode "temp.pir" - print "loaded\n" - $P0 = global "_sub2" + say "sub1" + load_bytecode "$temp_pir" + say "loaded" + \$P0 = global "_sub2" .begin_call - .call $P0 + .call \$P0 ret: .end_call - print "back\n" + say "back" end .end CODE @@ -335,35 +333,36 @@ OUT # write subs -open $FOO, '>', 'temp.pir' or die "Can't write temp.pir: $!\n"; +($FOO, $temp_pir) = tempfile( SUFFIX => '.pir' ); + print $FOO <<'ENDF'; .sub _sub1 - print "sub1\n" + say "sub1" $P0 = global "_sub2" .begin_call .call $P0 ret: .end_call - print "back\n" + say "back" end .end .sub _sub2 - print "sub2\n" + say "sub2" .begin_return .end_return end .end ENDF + close $FOO; # compile it -unlink 'temp.pbc'; -system_or_die( $PARROT, qw( -o temp.pbc temp.pir ) ); +system_or_die( $PARROT, '-o', $temp_pbc, $temp_pir ); use Test::More; -is( `$PARROT temp.pbc`, <<OUT, 'call internal sub like external, precompiled' ); +is( `$PARROT $temp_pbc`, <<OUT, 'call internal sub like external, precompiled' ); sub1 sub2 back @@ -374,7 +373,8 @@ # include a non-existent file and catch the error message my $err_msg; { - open $FOO, '>', 'temp.pir' or die "Can't write temp.pir: $!\n"; + ($FOO, $temp_pir) = tempfile( SUFFIX => '.pir' ); + print $FOO <<'END_PIR'; # Including a non-existent file should produce an error .include "non_existent.pir" @@ -385,15 +385,16 @@ .end END_PIR close $FOO; + my $OLDERR; open $OLDERR, '>&', 'STDERR' or die "Can't save STDERR: $!\n"; - open STDERR, '>', 'temp.out' or die "Can't write temp.out: $!\n"; - system( $PARROT, 'temp.pir' ); # We expect an error here. - open $FOO, '<', 'temp.out' or die "Can't read temp.out: $!\n"; + (undef, my $temp_out) = tempfile( SUFFIX => '.out' ); + open STDERR, '>', $temp_out or die "Can't write $temp_out: $!\n"; + system( $PARROT, $temp_pir ); # We expect an error here. + open $FOO, '<', $temp_out or die "Can't read $temp_out: $!\n"; { local $/; $err_msg = <$FOO>; } close $FOO; open STDERR, '>&', $OLDERR or die "Can't restore STDERR: $!\n"; - unlink 'temp.out'; } # read a non-existent file and catch the error message @@ -401,7 +402,8 @@ { open $FOO, '<', 'non_existent.file'; my $ENOENT = $! + 0; - open $FOO, '>', 'temp.pir' or die "Can't write temp.pir: $!\n"; + open $FOO, '>', $temp_pir or die "Can't write to '$temp_pir': $!\n"; + print $FOO <<"END_PIR"; .sub test \:main # run a OS command, and get the errmessge for the exit code @@ -412,15 +414,14 @@ .end END_PIR close $FOO; - $enoent_err_msg = qx{$PARROT temp.pir} + $enoent_err_msg = qx{$PARROT $temp_pir} } $err_msg =~ s/\r//g if $^O =~ /^(MSWin32|msys)$/i; is( $err_msg, << "OUT", 'including a non-existent file' ); error:imcc:$enoent_err_msg -\tin file 'temp.pir' line 2 +\tin file '$temp_pir' line 2 OUT - unlink 'temp.pir'; } SKIP: @@ -430,7 +431,7 @@ pir_output_is( <<'CODE', <<'OUT', 'twice call sub in external pir, return' ); .sub _sub1 print "sub1\n" - load_bytecode "temp.pir" + load_bytecode "$temp_pir" print "loaded\n" $P0 = global "_sub2" .begin_call @@ -439,7 +440,7 @@ .end_call print "back\n" print "sub1 again\n" - load_bytecode "temp.pir" + load_bytecode "$temp_pir" print "loaded again\n" $P0 = global "_sub2" .begin_call @@ -525,16 +526,6 @@ print "# Return $rc\n"; } -sub delete_temp_files { - for ( @temp_files, $file, 'temp.pir', 'temp.pbc' ) { - unlink if defined; - } -} - -END { - delete_temp_files() if $ended_ok; -} - # Local Variables: # mode: cperl # cperl-indent-level: 4 Modified: trunk/t/pmc/eval.t ============================================================================== --- trunk/t/pmc/eval.t (original) +++ trunk/t/pmc/eval.t Sun Oct 12 18:46:25 2008 @@ -1,11 +1,14 @@ #! perl -# Copyright (C) 2001-2007, The Perl Foundation. +# Copyright (C) 2001-2008, The Perl Foundation. # $Id$ use strict; use warnings; use lib qw( . lib ../lib ../../lib ); + use Test::More; +use File::Temp 'tempfile'; + use Parrot::Test tests => 17; =head1 NAME @@ -509,8 +512,8 @@ ok OUTPUT -open my $TEMP, '>', "temp.pir" or die "can't open 'temp.pir': $!"; -END { unlink "temp.pir" } +my ($TEMP, $filename) = tempfile( SUFFIX => '.pir' ); + print $TEMP <<PIR; .sub foo print a typo @@ -518,10 +521,10 @@ PIR close $TEMP; -pir_error_output_like( <<'CODE', <<'OUTPUT', "compile err in load_bytecode" ); +pir_error_output_like( <<"CODE", <<'OUTPUT', "compile err in load_bytecode" ); .sub main :main - load_bytecode "temp.pir" - print "never\n" + load_bytecode "$filename" + print "never\\n" end .end CODE @@ -531,7 +534,7 @@ pir_output_is( <<'CODE', <<'OUTPUT', "catch compile err in load_bytecode" ); .sub main :main push_eh handler - load_bytecode "temp.pir" + load_bytecode "$filename" print "never\n" end handler: Modified: trunk/t/pmc/multidispatch.t ============================================================================== --- trunk/t/pmc/multidispatch.t (original) +++ trunk/t/pmc/multidispatch.t Sun Oct 12 18:46:25 2008 @@ -1,5 +1,5 @@ #! perl -# Copyright (C) 2001-2007, The Perl Foundation. +# Copyright (C) 2001-2008, The Perl Foundation. # $Id$ use strict; @@ -7,6 +7,8 @@ use lib qw( . lib ../lib ../../lib ); use Test::More; +use File::Temp 'tempfile'; + use Parrot::Test tests => 44; =head1 NAME @@ -210,11 +212,9 @@ -42 OUTPUT -my $temp = "temp.pir"; -END { unlink $temp; } +my ($TEMP, $temp_pir) = tempfile( SUFFIX => '.pir' ); -open my $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +print $TEMP <<'EOF'; .sub Integer_divide_Integer .param pmc left .param pmc right @@ -223,26 +223,23 @@ .return(lhs) .end EOF -close $S; - -pir_output_is( <<'CODE', <<'OUTPUT', "PASM MMD divide - loaded sub" ); +close $TEMP; +pir_output_is( <<"CODE", <<'OUTPUT', "PASM MMD divide - loaded sub" ); .sub _main .local pmc divide - load_bytecode "temp.pir" + load_bytecode "$temp_pir" divide = global "Integer_divide_Integer" add_multi "divide", "Integer,Integer", divide - $P0 = new 'Integer' - $P1 = new 'Integer' - $P2 = new 'Integer' - $P1 = 10 - $P2 = 3 - $P0 = $P1 / $P2 - print $P0 - print "\n" + \$P0 = new 'Integer' + \$P1 = new 'Integer' + \$P2 = new 'Integer' + \$P1 = 10 + \$P2 = 3 + \$P0 = \$P1 / \$P2 + say \$P0 .end - CODE 42 OUTPUT @@ -930,11 +927,9 @@ 2 OUTPUT -## my $temp = "temp.pir"; -## END { unlink $temp; }; +($TEMP, $temp_pir) = tempfile( SUFFIX => '.pir' ); -open my $P, '>', "$temp" or die "can't write $temp"; -print $P <<'EOF'; +print $TEMP <<'EOF'; .namespace ["AInt"] .sub add :multi(AInt, Integer, PMC) .param pmc l @@ -948,20 +943,19 @@ .return(d) .end EOF -close $P; +close $TEMP; -pir_output_is( <<'CODE', <<'OUTPUT', "override builtin add" ); +pir_output_is( <<"CODE", <<'OUTPUT', "override builtin add" ); .sub main - load_bytecode "temp.pir" - $P0 = subclass "Integer", "AInt" - $P0 = new "AInt" - $P1 = new 'Integer' - set $P0, 6 - set $P1, 2 + load_bytecode "$temp_pir" + \$P0 = subclass "Integer", "AInt" + \$P0 = new "AInt" + \$P1 = new 'Integer' + set \$P0, 6 + set \$P1, 2 - $P2 = add $P0, $P1 - print $P2 - print "\n" + \$P2 = add \$P0, \$P1 + say \$P2 .end CODE 62 @@ -1234,7 +1228,7 @@ Called multi for class OUTPUT -pir_output_is( <<'CODE', <<'OUTPUT', "unicode sub names and multi (RT#39254)" ); +pir_output_is( <<'CODE', <<'OUTPUT', "unicode sub names and multi (RT #39254)" ); .sub unicode:"\u7777" :multi(string) .param pmc arg print 'String:' Modified: trunk/t/pmc/sub.t ============================================================================== --- trunk/t/pmc/sub.t (original) +++ trunk/t/pmc/sub.t Sun Oct 12 18:46:25 2008 @@ -7,6 +7,8 @@ use lib qw( . lib ../lib ../../lib ); use Test::More; +use File::Temp 'tempfile'; + use Parrot::Test tests => 65; use Parrot::Config; @@ -25,12 +27,6 @@ =cut -my $temp = "temp.pasm"; - -END { - unlink( $temp, 'temp.pbc', 'temp.pasm' ); -} - pasm_output_is( <<'CODE', <<'OUTPUT', "PASM subs - invokecc" ); .const .Sub P0 = "func" @@ -124,7 +120,7 @@ ok: print "ok 1\n" invokecc P0 - print "back\n" + say "back" end .pcc_sub _the_sub: print "in sub\n" @@ -143,7 +139,7 @@ ok: print "ok 1\n" invokecc P0 - print "back\n" + say "back" end .pcc_sub _the_sub: @@ -173,7 +169,7 @@ ok: print "ok 1\n" invokecc P0 - print "back\n" + say "back" end .pcc_sub _the::sub::some::where: print "in sub\n" @@ -184,27 +180,27 @@ back OUTPUT -open my $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +my ($TEMP, $temp_pasm) = tempfile( SUFFIX => '.pasm' ); +print $TEMP <<'EOF'; .pcc_sub _sub1: - print "in sub1\n" + say "in sub1" end EOF -close $S; +close $TEMP; -pasm_output_is( <<'CODE', <<'OUTPUT', "load_bytecode call sub" ); +pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode call sub" ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pasm" - print "loaded\n" + say "main" + load_bytecode "$temp_pasm" + say "loaded" get_global P0, "_sub1" defined I0, P0 if I0, ok1 print "not " ok1: - print "found sub\n" + say "found sub" invokecc P0 - print "never\n" + say "never" end CODE main @@ -213,27 +209,28 @@ in sub1 OUTPUT -open $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +($TEMP, $temp_pasm) = tempfile( SUFFIX => '.pasm' ); + +print $TEMP <<'EOF'; .pcc_sub _sub1: - print "in sub1\n" + say "in sub1" returncc EOF -close $S; +close $TEMP; -pasm_output_is( <<'CODE', <<'OUTPUT', "load_bytecode call sub, ret" ); +pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode call sub, ret" ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pasm" - print "loaded\n" + say "main" + load_bytecode "$temp_pasm" + say "loaded" get_global P0, "_sub1" defined I0, P0 if I0, ok1 print "not " ok1: - print "found sub\n" + say "found sub" invokecc P0 - print "back\n" + say "back" end CODE main @@ -243,42 +240,43 @@ back OUTPUT -open $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +($TEMP, $temp_pasm) = tempfile( SUFFIX => '.pasm' ); + +print $TEMP <<'EOF'; .pcc_sub _sub1: - print "in sub1\n" + say "in sub1" returncc .pcc_sub _sub2: - print "in sub2\n" + say "in sub2" returncc EOF -close $S; +close $TEMP; -pasm_output_is( <<'CODE', <<'OUTPUT', "load_bytecode call different subs, ret" ); +pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode call different subs, ret" ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pasm" - print "loaded\n" + say "main" + load_bytecode "$temp_pasm" + say "loaded" get_global P0, "_sub1" defined I0, P0 if I0, ok1 print "not " ok1: - print "found sub1\n" + say "found sub1" set P10, P0 invokecc P0 - print "back\n" + say "back" get_global P0, "_sub2" defined I0, P0 if I0, ok2 print "not " ok2: - print "found sub2\n" + say "found sub2" invokecc P0 - print "back\n" + say "back" set P0, P10 invokecc P0 - print "back\n" + say "back" end CODE main @@ -293,15 +291,17 @@ back OUTPUT -system(".$PConfig{slash}parrot$PConfig{exe} -o temp.pbc $temp"); +my (undef, $temp_pbc) = tempfile( SUFFIX => '.pbc' ); + +system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm); -pir_output_is( <<'CODE', <<'OUTPUT', "load_bytecode Sx" ); +pir_output_is( <<"CODE", <<'OUTPUT', "load_bytecode Sx" ); .sub main :main - $S0 = 'temp.pasm' - load_bytecode $S0 + \$S0 = '$temp_pasm' + load_bytecode \$S0 _sub1() - $S0 = 'temp.pbc' - load_bytecode $S0 + \$S0 = '$temp_pbc' + load_bytecode \$S0 _sub2() .end CODE @@ -309,31 +309,31 @@ in sub2 OUTPUT -pasm_output_is( <<'CODE', <<'OUTPUT', "load_bytecode PBC call different subs, ret" ); +pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode PBC call different subs, ret" ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pbc" - print "loaded\n" + say "main" + load_bytecode "$temp_pasm" + say "loaded" get_global P0, "_sub1" defined I0, P0 if I0, ok1 print "not " ok1: - print "found sub1\n" + say "found sub1" set P10, P0 invokecc P0 - print "back\n" + say "back" get_global P0, "_sub2" defined I0, P0 if I0, ok2 print "not " ok2: - print "found sub2\n" + say "found sub2" invokecc P0 - print "back\n" + say "back" set P0, P10 invokecc P0 - print "back\n" + say "back" end CODE main @@ -412,19 +412,20 @@ ok OUT -open $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +($TEMP, $temp_pasm) = tempfile( SUFFIX => '.pasm' ); + +print $TEMP <<'EOF'; .pcc_sub :load _sub1: - print "in sub1\n" + say "in sub1" returncc EOF -close $S; +close $TEMP; -pasm_output_is( <<'CODE', <<'OUTPUT', 'load_bytecode :load' ); +pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode :load' ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pasm" - print "back\n" + say "main" + load_bytecode "$temp_pasm" + say "back" end CODE main @@ -432,21 +433,22 @@ back OUTPUT -open $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +($TEMP, $temp_pasm) = tempfile( SUFFIX => '.pasm' ); + +print $TEMP <<'EOF'; .pcc_sub _error: - print "error\n" + say "error" .pcc_sub :load _sub1: - print "in sub1\n" + say "in sub1" returncc EOF -close $S; +close $TEMP; -pasm_output_is( <<'CODE', <<'OUTPUT', 'load_bytecode :load second sub' ); +pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode :load second sub' ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pasm" - print "back\n" + say "main" + load_bytecode "$temp_pasm" + say "back" end CODE main @@ -454,13 +456,13 @@ back OUTPUT -system(".$PConfig{slash}parrot$PConfig{exe} -o temp.pbc $temp"); +system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm ); -pasm_output_is( <<'CODE', <<'OUTPUT', 'load_bytecode :load in pbc' ); +pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode :load in pbc' ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pbc" - print "back\n" + say "main" + load_bytecode "$temp_pbc" + say "back" end CODE main @@ -468,25 +470,26 @@ back OUTPUT -open $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +($TEMP, $temp_pasm) = tempfile( SUFFIX => '.pasm' ); + +print $TEMP <<'EOF'; .pcc_sub :load _sub1: - print "in sub1\n" + say "in sub1" returncc .pcc_sub _sub2: print "in sub2\n" returncc EOF -close $S; +close $TEMP; -pasm_output_is( <<'CODE', <<'OUTPUT', "load_bytecode autorun first" ); +pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun first" ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pasm" - print "loaded\n" + say "main" + load_bytecode "$temp_pasm" + say "loaded" get_global P0, "_sub2" invokecc P0 - print "back\n" + say "back" end CODE main @@ -496,16 +499,16 @@ back OUTPUT -system(".$PConfig{slash}parrot$PConfig{exe} -o temp.pbc $temp"); +system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm ); -pasm_output_is( <<'CODE', <<'OUTPUT', "load_bytecode autorun first in pbc" ); +pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun first in pbc" ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pbc" - print "loaded\n" + say "main" + load_bytecode "$temp_pbc" + say "loaded" get_global P0, "_sub2" invokecc P0 - print "back\n" + say "back" end CODE main @@ -515,25 +518,26 @@ back OUTPUT -open $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +($TEMP, $temp_pasm) = tempfile( SUFFIX => '.pasm' ); + +print $TEMP <<'EOF'; .pcc_sub _sub1: - print "in sub1\n" + say "in sub1" returncc .pcc_sub :load _sub2: print "in sub2\n" returncc EOF -close $S; +close $TEMP; -pasm_output_is( <<'CODE', <<'OUTPUT', "load_bytecode autorun second" ); +pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun second" ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pasm" - print "loaded\n" + say "main" + load_bytecode "$temp_pasm" + say "loaded" get_global P0, "_sub1" invokecc P0 - print "back\n" + say "back" end CODE main @@ -543,16 +547,16 @@ back OUTPUT -system(".$PConfig{slash}parrot$PConfig{exe} -o temp.pbc $temp"); +system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm ); -pasm_output_is( <<'CODE', <<'OUTPUT', "load_bytecode autorun second in pbc" ); +pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun second in pbc" ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pbc" - print "loaded\n" + say "main" + load_bytecode "$temp_pbc" + say "loaded" get_global P0, "_sub1" invokecc P0 - print "back\n" + say "back" end CODE main @@ -562,25 +566,26 @@ back OUTPUT -open $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +($TEMP, $temp_pasm) = tempfile( SUFFIX => '.pasm' ); + +print $TEMP <<'EOF'; .pcc_sub :load _sub1: - print "in sub1\n" + say "in sub1" returncc .pcc_sub :load _sub2: print "in sub2\n" returncc EOF -close $S; +close $TEMP; -pasm_output_is( <<'CODE', <<'OUTPUT', "load_bytecode autorun both" ); +pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun both" ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pasm" - print "loaded\n" + say "main" + load_bytecode "$temp_pasm" + say "loaded" get_global P0, "_sub1" invokecc P0 - print "back\n" + say "back" end CODE main @@ -591,16 +596,16 @@ back OUTPUT -system(".$PConfig{slash}parrot$PConfig{exe} -o temp.pbc $temp"); +system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm ); -pasm_output_is( <<'CODE', <<'OUTPUT', "load_bytecode autorun both in pbc" ); +pasm_output_is( <<"CODE", <<'OUTPUT', "load_bytecode autorun both in pbc" ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pbc" - print "loaded\n" + say "main" + load_bytecode "$temp_pbc" + say "loaded" get_global P0, "_sub1" invokecc P0 - print "back\n" + say "back" end CODE main @@ -616,7 +621,7 @@ print "first\n" returncc .pcc_sub :main _main: - print "main\n" + say "main" end CODE main @@ -627,7 +632,7 @@ print "first\n" returncc .pcc_sub :main _main: - print "main\n" + say "main" end .pcc_sub :main _second: print "second\n" @@ -644,7 +649,7 @@ print "second\n" returncc .pcc_sub :main _main: - print "main\n" + say "main" get_global P0, "_first" invokecc P0 get_global P0, "_second" @@ -674,21 +679,20 @@ /too few arguments passed $1$ - 2 params expected/ OUTPUT -$temp = "temp.pir"; -open $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +($TEMP, $temp_pasm) = tempfile(); +print $TEMP <<'EOF'; .sub _sub1 :load - print "in sub1\n" + say "in sub1" returncc .end EOF -close $S; +close $TEMP; -pasm_output_is( <<'CODE', <<'OUTPUT', 'load_bytecode :load first sub - pir' ); +pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode :load first sub - pir' ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pir" - print "back\n" + say "main" + load_bytecode "$temp_pasm" + say "back" end CODE main @@ -696,8 +700,8 @@ back OUTPUT -open $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +($TEMP, $temp_pasm) = tempfile(); +print $TEMP <<'EOF'; .sub _foo print "error\n" .end @@ -705,17 +709,17 @@ # :load or other pragmas are only evaluated on the first # instruction of a compilation unit .sub _sub1 :load - print "in sub1\n" + say "in sub1" returncc .end EOF -close $S; +close $TEMP; -pasm_output_is( <<'CODE', <<'OUTPUT', 'load_bytecode :load second sub - pir' ); +pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode :load second sub - pir' ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pir" - print "back\n" + say "main" + load_bytecode "$temp_pasm" + say "back" end CODE main @@ -723,23 +727,24 @@ back OUTPUT -open $S, '>', "$temp" or die "Can't write $temp"; -print $S <<'EOF'; +($TEMP, my $temp_pir) = tempfile( SUFFIX => '.pir' ); + +print $TEMP <<'EOF'; .sub _foo print "error\n" .end .sub _sub1 - print "in sub1\n" + say "in sub1" returncc .end EOF -close $S; +close $TEMP; -pasm_output_is( <<'CODE', <<'OUTPUT', 'load_bytecode no :load - pir' ); +pasm_output_is( <<"CODE", <<'OUTPUT', 'load_bytecode no :load - pir' ); .pcc_sub _main: - print "main\n" - load_bytecode "temp.pir" - print "back\n" + say "main" + load_bytecode "$temp_pir" + say "back" end CODE main @@ -747,7 +752,7 @@ OUTPUT # This is the behavior of Parrot 0.4.3 -# RT#46817 Should there be a warning ? +# RT #46817 Should there be a warning ? pir_output_is( <<'CODE', '', 'warn on in main' ); .sub _main :main .include "warnings.pasm" @@ -775,7 +780,7 @@ ok OUTPUT -# RT#46819 This is the behavior of Parrot 0.4.3 +# RT #46819 This is the behavior of Parrot 0.4.3 # It looks like core PMCs never emit warning. # Look in perlundef.t for a more sane test of 'warningson' in subs pir_output_is( <<'CODE', <<'OUTPUT', "warn on in sub, turn off in f2" ); @@ -783,7 +788,7 @@ .include "warnings.pasm" _f1() $P0 = new 'Undef' - print "back\n" + say "back" print $P0 print "ok\n" .end @@ -920,7 +925,7 @@ print "initial\n" .end .sub _main :main - print "main\n" + say "main" .end CODE my $descr = ':immediate :postcomp'; @@ -970,8 +975,10 @@ nofoo/ OUTPUT -open $S, '>', "test_l1.pir" or die "Can't write test_l1.pir"; -print $S <<'EOF'; +($TEMP, my $l1_pir) = tempfile( SUFFIX => '.pir' ); +(my $l1_pbc = $l1_pir) =~ s/\.pir/.pbc/; + +print $TEMP <<'EOF'; .sub l11 :load print "l11\n" .end @@ -980,10 +987,12 @@ print "l12\n" .end EOF -close $S; +close $TEMP; + +($TEMP, my $l2_pir) = tempfile( SUFFIX => '.pir' ); +(my $l2_pbc = $l2_pir) =~ s/\.pir/.pbc/; -open $S, '>', "test_l2.pir" or die "Can't write test_l2.pir"; -print $S <<'EOF'; +print $TEMP <<'EOF'; .sub l21 :load print "l21\n" .end @@ -992,22 +1001,20 @@ print "l22\n" .end EOF -close $S; - -system(".$PConfig{slash}parrot$PConfig{exe} -o test_l1.pbc test_l1.pir"); -system(".$PConfig{slash}parrot$PConfig{exe} -o test_l2.pbc test_l2.pir"); +close $TEMP; -END { unlink(qw/ test_l1.pir test_l2.pir test_l1.pbc test_l2.pbc /); } +system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $l1_pbc, $l1_pir); +system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $l2_pbc, $l2_pir); -pir_output_is( <<'CODE', <<'OUTPUT', 'multiple :load' ); +pir_output_is( <<"CODE", <<'OUTPUT', 'multiple :load' ); .sub main :main - print "main 1\n" - load_bytecode "test_l1.pir" - load_bytecode "test_l2.pir" - print "main 2\n" - load_bytecode "test_l1.pbc" # these have to be ignored - load_bytecode "test_l2.pbc" - print "main 3\n" + say "main 1" + load_bytecode "$l1_pir" + load_bytecode "$l2_pir" + say "main 2" + load_bytecode "$l1_pbc" # these have to be ignored + load_bytecode "$l2_pbc" + say "main 3" .end CODE main 1 @@ -1109,7 +1116,7 @@ OUTPUT pir_output_like( - <<"CODE", <<'OUTPUT', 'warn on in main', todo => "RT#46819 core undef doesn't warn here. Should it?" ); + <<"CODE", <<'OUTPUT', 'warn on in main', todo => "RT #46819 core undef doesn't warn here. Should it?" ); .sub 'test' :main .include "warnings.pasm" warningson .PARROT_WARNINGS_UNDEF_FLAG @@ -1129,7 +1136,7 @@ _f1() P0 = new 'Undef' print P0 - print "ok\\n" + say "ok" .end .sub _f1 warningson .PARROT_WARNINGS_UNDEF_FLAG @@ -1139,14 +1146,14 @@ OUTPUT pir_output_like( - <<"CODE", <<'OUTPUT', 'warn on in sub, turn off in f2', todo => "RT#46819 core undef doesn't warn here. Should it?" ); + <<"CODE", <<'OUTPUT', 'warn on in sub, turn off in f2', todo => "RT #46819 core undef doesn't warn here. Should it?" ); .sub 'test' :main .include "warnings.pasm" _f1() P0 = new 'Undef' - print "back\\n" + say "back" print P0 - print "ok\\n" + say "ok" .end .sub _f1 warningson .PARROT_WARNINGS_UNDEF_FLAG @@ -1163,7 +1170,7 @@ pir_output_is( <<'CODE', <<'OUTPUT', ':postcomp' ); .sub main :main - print "main\n" + say "main" .end .sub pc :postcomp print "pc\n" @@ -1302,7 +1309,7 @@ .end .sub main :main - print "main\n" + say "main" .end CODE in inited Modified: trunk/t/pmc/sys.t ============================================================================== --- trunk/t/pmc/sys.t (original) +++ trunk/t/pmc/sys.t Sun Oct 12 18:46:25 2008 @@ -1,11 +1,14 @@ #! perl -# Copyright (C) 2001-2005, The Perl Foundation. +# Copyright (C) 2001-2008, The Perl Foundation. # $Id$ use strict; use warnings; use lib qw( . lib ../lib ../../lib ); + use Test::More; +use File::Temp 'tempfile'; + use Parrot::Test tests => 2; =head1 NAME @@ -22,18 +25,16 @@ =cut -END { - unlink "temp.pir"; -} +my (undef, $temp_pir) = tempfile( SUFFIX => '.pir' ); -pir_output_is( <<'CODE', <<OUT, "spawnw, _config" ); +pir_output_is( <<"CODE", <<OUT, "spawnw, _config" ); .sub _test :main .local pmc O - open O, "temp.pir", ">" - print O, ".sub _main :main\n" - print O, "\tprint \"Hello, World!\\n\"\n" - print O, ".end\n" + open O, "$temp_pir", ">" + print O, ".sub _main :main\\n" + print O, "\tsay \\"Hello, World!\\"\\n" + print O, ".end\\n" close O .local pmc conf_hash conf_hash = _config() @@ -45,10 +46,9 @@ cmd = '.' cmd .= slash cmd .= parrot - cmd .= " temp.pir" - spawnw $I0, cmd - print $I0 - print "\n" + cmd .= " $temp_pir" + spawnw \$I0, cmd + say \$I0 .end .include "library/config.pir" Modified: trunk/t/src/extend.t ============================================================================== --- trunk/t/src/extend.t (original) +++ trunk/t/src/extend.t Sun Oct 12 18:46:25 2008 @@ -7,6 +7,8 @@ use lib qw( . lib ../lib ../../lib ); use Test::More; +use File::Temp 'tempfile'; + use Parrot::Test; use Parrot::Config; @@ -390,9 +392,9 @@ 6 OUTPUT -my $temp = 'temp'; -open my $S, '>', "$temp.pasm" or die "Can't write $temp.pasm"; -print $S <<'EOF'; +my ($TEMP, $temp_pasm) = tempfile( SUFFIX => '.pasm' ); + +print $TEMP <<'EOF'; .pcc_sub _sub1: get_params "" printerr "in sub1\n" @@ -405,12 +407,13 @@ set_returns "" returncc EOF -close $S; +close $TEMP; # compile to pbc -system(".$PConfig{slash}parrot$PConfig{exe} -o $temp.pbc $temp.pasm"); +my (undef, $temp_pbc) = tempfile( SUFFIX => '.pbc' ); +system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm); -c_output_is( <<'CODE', <<'OUTPUT', 'call a parrot sub' ); +c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub' ); #include <parrot/parrot.h> #include <parrot/embed.h> @@ -437,14 +440,14 @@ static opcode_t* the_test(Parrot_Interp interp, opcode_t *cur_op, opcode_t *start) { - PackFile *pf = Parrot_readbc(interp, "temp.pbc"); + PackFile *pf = Parrot_readbc(interp, "$temp_pbc"); STRING *name = const_string(interp, "_sub1"); PMC *sub, *arg; Parrot_loadbc(interp, pf); sub = Parrot_find_global_cur(interp, name); Parrot_call_sub(interp, sub, "v"); - Parrot_eprintf(interp, "back\n"); + Parrot_eprintf(interp, "back\\n"); /* win32 seems to buffer stderr ? */ PIO_flush(interp, PIO_STDERR(interp)); @@ -457,7 +460,7 @@ string_from_cstring(interp, "hello ", 0)); Parrot_call_sub(interp, sub, "vP", arg); - Parrot_eprintf(interp, "back\n"); + Parrot_eprintf(interp, "back\\n"); return NULL; } @@ -468,8 +471,9 @@ back OUTPUT -open $S, '>', "$temp.pasm" or die "Can't write $temp.pasm"; -print $S <<'EOF'; +($TEMP, $temp_pasm) = tempfile( SUFFIX => '.pasm' ); + +print $TEMP <<'EOF'; .pcc_sub _sub1: get_params "" printerr "in sub1\n" @@ -477,13 +481,12 @@ printerr "never\n" returncc EOF -close $S; +close $TEMP; # compile to pbc -unlink "$temp.pbc"; -system(".$PConfig{slash}parrot$PConfig{exe} -o $temp.pbc $temp.pasm"); +system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pasm); -c_output_is( <<'CODE', <<'OUTPUT', 'call a parrot sub, catch exception' ); +c_output_is( <<"CODE", <<'OUTPUT', 'call a parrot sub, catch exception' ); #include <parrot/parrot.h> #include <parrot/embed.h> @@ -511,7 +514,7 @@ static opcode_t* the_test(Parrot_Interp interp, opcode_t *cur_op, opcode_t *start) { - PackFile *pf = Parrot_readbc(interp, "temp.pbc"); + PackFile *pf = Parrot_readbc(interp, "$temp_pbc"); STRING *name = const_string(interp, "_sub1"); PMC *sub; Parrot_runloop jump_point; @@ -520,7 +523,7 @@ sub = Parrot_find_global_cur(interp, name); if (setjmp(jump_point.resume)) { - Parrot_eprintf(interp, "caught\n"); + Parrot_eprintf(interp, "caught\\n"); } else { /* pretend the EH was pushed by the sub call. */ @@ -530,7 +533,7 @@ Parrot_call_sub(interp, sub, "v"); } - Parrot_eprintf(interp, "back\n"); + Parrot_eprintf(interp, "back\\n"); return NULL; } @@ -540,8 +543,9 @@ back OUTPUT -open $S, '>', "$temp.pir" or die "Can't write $temp.pir"; -print $S <<'EOF'; +($TEMP, my $temp_pir) = tempfile( SUFFIX => '.pir' ); + +print $TEMP <<'EOF'; .sub main :main .param pmc argv @@ -576,13 +580,12 @@ .return( sum ) .end EOF -close $S; +close $TEMP; # compile to pbc -unlink "$temp.pbc"; -system(".$PConfig{slash}parrot$PConfig{exe} -o $temp.pbc $temp.pir"); +system(".$PConfig{slash}parrot$PConfig{exe}", '-o', $temp_pbc, $temp_pir); -c_output_is( <<'CODE', <<'OUTPUT', 'eval code through a parrot sub - #39669' ); +c_output_is( <<"CODE", <<'OUTPUT', 'eval code through a parrot sub - #39669' ); #include <parrot/parrot.h> #include <parrot/embed.h> @@ -591,18 +594,18 @@ main(int argc, char* argv[]) { Parrot_PackFile packfile; - char * code[] = { ".sub foo\nprint\"Hello from foo!\\n\"\n.end\n" }; + char * code[] = { ".sub foo\\nsay \\"Hello from foo!\\"\\n.end\\n" }; Parrot_Interp interp = Parrot_new(NULL); if (!interp) { - printf( "Hiss\n" ); + printf( "Hiss\\n" ); return 1; } - packfile = Parrot_readbc( interp, "temp.pbc" ); + packfile = Parrot_readbc( interp, "$temp_pbc" ); if (!packfile) { - printf( "Boo\n" ); + printf( "Boo\\n" ); return 1; } @@ -681,7 +684,7 @@ return 1; } - pf = Parrot_readbc( interp, "$temp.pbc" ); + pf = Parrot_readbc( interp, "$temp_pbc" ); Parrot_loadbc( interp, pf ); sub = Parrot_find_global_cur( interp, const_string( interp, "add" ) ); @@ -748,8 +751,6 @@ Destroying interp 2 OUTPUT -unlink "$temp.pasm", "$temp.pir", "$temp.pbc" unless $ENV{POSTMORTEM}; - # Local Variables: # mode: cperl # cperl-indent-level: 4 http://www.nntp.perl.org/group/perl.cvs.parrot/2008/10/msg32312.html Sun, 12 Oct 2008 18:46:43 +0000 [svn:parrot] r31917 - in trunk: include/parrot src by chromatic Author: chromatic Date: Sun Oct 12 16:44:22 2008 New Revision: 31917 Modified: trunk/include/parrot/debugger.h trunk/src/debug.c Log: [debug] Cleaned up some signedness and conversion warnings in the debugger. Modified: trunk/include/parrot/debugger.h ============================================================================== --- trunk/include/parrot/debugger.h (original) +++ trunk/include/parrot/debugger.h Sun Oct 12 16:44:22 2008 @@ -166,7 +166,7 @@ PDB_file_t *file; PDB_breakpoint_t *breakpoint; PDB_condition_t *watchpoint; - long breakpoint_skip; + unsigned long breakpoint_skip; char *cur_command; char *last_command; opcode_t *cur_opcode; @@ -265,7 +265,7 @@ size_t PDB_disassemble_op(PARROT_INTERP, ARGOUT(char *dest), - int space, + size_t space, ARGIN(const op_info_t *info), ARGIN(const opcode_t *op), ARGMOD_NULLOK(PDB_file_t *file), @@ -284,7 +284,7 @@ PARROT_WARN_UNUSED_RESULT PARROT_CAN_RETURN_NULL PARROT_MALLOC -char * PDB_escape(ARGIN(const char *string), INTVAL length) +char * PDB_escape(ARGIN(const char *string), UINTVAL length) __attribute__nonnull__(1); void PDB_eval(PARROT_INTERP, ARGIN(const char *command)) @@ -341,7 +341,7 @@ void PDB_set_break(PARROT_INTERP, ARGIN_NULLOK(const char *command)) __attribute__nonnull__(1); -void PDB_skip_breakpoint(PARROT_INTERP, long i) +void PDB_skip_breakpoint(PARROT_INTERP, unsigned long i) __attribute__nonnull__(1); void PDB_trace(PARROT_INTERP, ARGIN_NULLOK(const char *command)) Modified: trunk/src/debug.c ============================================================================== --- trunk/src/debug.c (original) +++ trunk/src/debug.c Sun Oct 12 16:44:22 2008 @@ -469,7 +469,7 @@ "Add a watchpoint" }; -static const DebuggerCmd * get_command(long cmdhash) /* HEADERIZER SKIP */ +static const DebuggerCmd * get_command(unsigned long cmdhash) /* HEADERIZER SKIP */ { switch ((enum DebugCmd)cmdhash) { case debug_cmd_break: @@ -698,7 +698,8 @@ } /* create the output STRING */ - *strP = string_make(interp, string_start, str - string_start, NULL, 0); + *strP = string_make(interp, string_start, (UINTVAL)(str - string_start), + NULL, 0); /* skip the closing quote */ if (*str) @@ -1193,7 +1194,8 @@ TRACEDEB_MSG("PDB_run_command"); - cmd= get_command(c); + cmd = get_command(c); + if (cmd) { (* cmd->func)(pdb, cmdline); return 0; @@ -1513,8 +1515,9 @@ #if TRACE_DEBUGGER fprintf(stderr, "PDB_break: '%s'\n", str); #endif - condition->value = string_make(interp, - str, i - 1, NULL, 0); + condition->value = string_make(interp, str, (UINTVAL)(i - 1), + NULL, 0); + condition->type |= PDB_cond_const; } else if (condition->type & PDB_cond_pmc) { @@ -1724,11 +1727,13 @@ /* Skip any breakpoint? */ if (command) ln = get_ulong(& command, 0); + if (ln != 0) { if (!pdb->breakpoint) { PIO_eprintf(pdb->debugger, "No breakpoints to skip\n"); return; } + PDB_skip_breakpoint(interp, ln); } @@ -1930,7 +1935,7 @@ */ void -PDB_skip_breakpoint(PARROT_INTERP, long i) +PDB_skip_breakpoint(PARROT_INTERP, unsigned long i) { #if TRACE_DEBUGGER fprintf(stderr, "PDB_skip_breakpoint: %li\n", i); @@ -2175,7 +2180,7 @@ PARROT_CAN_RETURN_NULL PARROT_MALLOC char * -PDB_escape(ARGIN(const char *string), INTVAL length) +PDB_escape(ARGIN(const char *string), UINTVAL length) { const char *end; char *_new, *fill; @@ -2295,7 +2300,7 @@ */ size_t -PDB_disassemble_op(PARROT_INTERP, ARGOUT(char *dest), int space, +PDB_disassemble_op(PARROT_INTERP, ARGOUT(char *dest), size_t space, ARGIN(const op_info_t *info), ARGIN(const opcode_t *op), ARGMOD_NULLOK(PDB_file_t *file), ARGIN_NULLOK(const opcode_t *code_start), int full_name) @@ -3153,6 +3158,7 @@ parse_command(cmdline, &c); cmd = get_command(c); + if (cmd) { PIO_eprintf(interp->pdb->debugger, "%s\n", cmd->help); } http://www.nntp.perl.org/group/perl.cvs.parrot/2008/10/msg32311.html Sun, 12 Oct 2008 16:44:32 +0000 [svn:parrot] r31916 - in trunk: . languages/perl6/config/makefiles languages/perl6/t languages/perl6/tools by moritz Author: moritz Date: Sun Oct 12 12:27:23 2008 New Revision: 31916 Added: trunk/languages/perl6/t/spectest.data - copied unchanged from r31914, /trunk/languages/perl6/t/spectest_regression.data Removed: trunk/languages/perl6/t/spectest_regression.data trunk/languages/perl6/tools/fudge_purity_inspector.pl Modified: trunk/MANIFEST trunk/languages/perl6/config/makefiles/root.in trunk/languages/perl6/tools/autounfudge.pl trunk/languages/perl6/tools/test_summary.pl trunk/languages/perl6/tools/update_passing_test_data.pl Log: [rakudo] rename t/spectest_regression.data to t/spectest.data and update tools/*. Also removed tools/fudge_purity_inspector.pl which doesn't make sense any more Modified: trunk/MANIFEST ============================================================================== --- trunk/MANIFEST (original) +++ trunk/MANIFEST Sun Oct 12 12:27:23 2008 @@ -1,7 +1,7 @@ # ex: set ro: # $Id$ # -# generated by tools/dev/mk_manifest_and_skip.pl Wed Oct 8 23:45:51 2008 UT +# generated by tools/dev/mk_manifest_and_skip.pl Sun Oct 12 19:24:12 2008 UT # # See tools/dev/install_files.pl for documentation on the # format of this file. @@ -2171,9 +2171,8 @@ languages/perl6/t/pmc/perl6multisub-basic.t [perl6] languages/perl6/t/pmc/perl6multisub-tiebreak.t [perl6] languages/perl6/t/pmc/perl6multisub-type.t [perl6] -languages/perl6/t/spectest_regression.data [perl6] +languages/perl6/t/spectest.data [perl6] languages/perl6/tools/autounfudge.pl [perl6] -languages/perl6/tools/fudge_purity_inspector.pl [perl6] languages/perl6/tools/progress-graph.pl [perl6] languages/perl6/tools/test_summary.pl [perl6] languages/perl6/tools/update_passing_test_data.pl [perl6] Modified: trunk/languages/perl6/config/makefiles/root.in ============================================================================== --- trunk/languages/perl6/config/makefiles/root.in (original) +++ trunk/languages/perl6/config/makefiles/root.in Sun Oct 12 12:27:23 2008 @@ -206,11 +206,11 @@ # Run the spectests that we know work. spectest_regression: spectest -spectest: all t/spec t/spectest_regression.data +spectest: all t/spec t/spectest.data -cd t/spec && svn up - $(HARNESS_WITH_FUDGE_JOBS) --tests-from-file=t/spectest_regression.data + $(HARNESS_WITH_FUDGE_JOBS) --tests-from-file=t/spectest.data -fulltest: coretest spectest_regression codetest +fulltest: coretest spectest codetest # Run the tests in t/localtest.data localtest: all t/spec t/localtest.data Modified: trunk/languages/perl6/tools/autounfudge.pl ============================================================================== --- trunk/languages/perl6/tools/autounfudge.pl (original) +++ trunk/languages/perl6/tools/autounfudge.pl Sun Oct 12 12:27:23 2008 @@ -8,7 +8,7 @@ =head1 DESCRIPTION -This tool runs the non-pure tests of the C<spectest_regression> make target, +This tool runs the non-pure tests of the C<spectest> make target, automatically creates files with less fudges, runs them again, and if the modified tests succeeds, it adds a patch to C<autounfudge.patch> that, when applied as C<< patch -p0 < autunfudge.patch >>, removes the superflous fudge @@ -78,7 +78,7 @@ my @files; -$specfile = 't/spectest_regression.data' if $auto; +$specfile = 't/spectest.data' if $auto; if ($specfile){ @files = read_specfile($specfile); @@ -190,7 +190,7 @@ --debug Enable debug output --impl impl Specify a different implementation --specfile file Specification file to read filenames from - --auto use t/spectest_regression.data for --specfile + --auto use t/spectest.data for --specfile --keep-env Keep PERL6LIB environment variable. --exclude regex Don't run the tests that match regex USAGE Modified: trunk/languages/perl6/tools/test_summary.pl ============================================================================== --- trunk/languages/perl6/tools/test_summary.pl (original) +++ trunk/languages/perl6/tools/test_summary.pl Sun Oct 12 12:27:23 2008 @@ -3,9 +3,9 @@ # Copyright (C) 2004-2008, The Perl Foundation. # $Id$ -## The "make spectest_regression" target tells us how many +## The "make spectest" target tells us how many ## tests we failed (hopefully zero!), but doesn't say how -## many were actually passed. This script runs the spectest_regression +## many were actually passed. This script runs the spectest ## tests and summarizes planned, actual, passed, failed, todoed, ## and skipped test results. ## @@ -18,7 +18,7 @@ use strict; use warnings; -my $testlist = $ARGV[0] || 't/spectest_regression.data'; +my $testlist = $ARGV[0] || 't/spectest.data'; my $fh; open($fh, '<', $testlist) || die "Can't read $testlist: $!"; Modified: trunk/languages/perl6/tools/update_passing_test_data.pl ============================================================================== --- trunk/languages/perl6/tools/update_passing_test_data.pl (original) +++ trunk/languages/perl6/tools/update_passing_test_data.pl Sun Oct 12 12:27:23 2008 @@ -5,13 +5,13 @@ =head1 DESCRIPTION This tool runs the same test that C<make spectest> would, except those that -C<make spectest_regression> runs. +C<make spectest> runs. For each file that passes at least one test (criterion might change in future) it prints out a short summary about the status of this file. This is primarily used to identify tests that could be added to -F<t/spectest_regression.data>, and those that are worth a closer look. But +F<t/spectest.data>, and those that are worth a closer look. But please don't add them blindly just because they all pass - chances are that there's a good reason for them not already being included. @@ -31,7 +31,7 @@ my %not_process; { - my @not_process = read_specfile('t/spectest_regression.data'); + my @not_process = read_specfile('t/spectest.data'); @not_process{@not_process} = (1) x @not_process; } http://www.nntp.perl.org/group/perl.cvs.parrot/2008/10/msg32310.html Sun, 12 Oct 2008 12:27:39 +0000 [svn:parrot] r31915 - in trunk/languages/perl6: . config/makefiles by moritz Author: moritz Date: Sun Oct 12 12:19:08 2008 New Revision: 31915 Modified: trunk/languages/perl6/README trunk/languages/perl6/config/makefiles/root.in Log: [rakudo] rename test targets * spectest_regression -> spectest * spectest -> spectest_full spectest_regression remains as an alias for spectest for backwards compatibility Modified: trunk/languages/perl6/README ============================================================================== --- trunk/languages/perl6/README (original) +++ trunk/languages/perl6/README Sun Oct 12 12:19:08 2008 @@ -45,10 +45,10 @@ to make sure that the Rakudo compiler is basically working and that it's capable of running a simple test harness. -Running "make spectest_regression" will import relevant portions +Running "make spectest" will import relevant portions of the "official Perl 6 test suite" from the Pugs repository -(http://svn.pugscode.org/pugs/t/spec/) and run all tests from -there. +(http://svn.pugscode.org/pugs/t/spec/) and run all of these tests that +are currently known to pass. At present we do not have any plans to directly store the official test suite as part of the Rakudo/Parrot repository, Modified: trunk/languages/perl6/config/makefiles/root.in ============================================================================== --- trunk/languages/perl6/config/makefiles/root.in (original) +++ trunk/languages/perl6/config/makefiles/root.in Sun Oct 12 12:19:08 2008 @@ -165,8 +165,9 @@ @echo " coretest: Run rakudo's core tests." @echo " codetest: Run Parrot's code tests." @echo " testclean: Clean up test results." - @echo " spectest: Run the official Perl 6 tests." - @echo " spectest_regression: Run the tests of the official test suite that are known to pass." + @echo " spectest: Run the tests of the official test suite that are known to pass." + @echo " spectest: Run the tests of the official test suite that are known to pass." + @echo " spectest_full: Run all tests of the official test suite" @echo " localtest: Run the official tests given in t/localtest.data." @echo " fulltest: Run coretest, spectest_regress