Refactor t/modules.t to use the new modules.pm, shared with t/testm.sh

Added missing t/qr_loaded_modules.pm to fix test 33
Require IPC::Run for test timeouts

CC: Remove strawberry PerlProc_setjmp definition, #define PERL_CORE fixed that
    Disabled inlined pp_enter: Fails on empty cxstack. 
    Backed out inlining of enterloop: GIMME_V fails on freebsd7

C: Add PVNV inf check to 5.8 also
   Defined PERL_CORE: Fxied Windows problems with setjmp undef'ed in XSUB.h
   Defer xpvmg->pv init to run-time < 5.10. Fixes MooseX::Types
   Added Win32 workaround for missing PL_do_undump
   Use NeWx and Fix missing Newx (strawberry)
   Stripped perl_ prefix from perl_get_cv, perl_call_pv, perl_call_method



git-svn-id: http://perl-compiler.googlecode.com/svn/trunk@356 ed534f1a-1453-0410-ab30-dfc593a8b23c

Changes

@@ -4,15 +4,24 @@
 	quite fine with Perl 5.6 and 5.8
 
 1.19	2010-02-13 rurban
+	Almost fixed evaltry (12) with proper cop_seq setup, just solaris and debian
+	fail sometimes. Tested ok with strawberry 5.10.1
 
 	* C.pm: fixed evaltry (test 12) mostly, NVX was shared with 2 xpad_cop_seq ints
 	  which accidently just worked before 1.17 with %s, but not after changing 
 	  to the %g representation.
 	Ignore unused random (overlong) xpviv IV, causing
 	  "warning: this decimal constant is unsigned only in ISO C90"
 	Defer rv => cv to run-time < 5.10. Fixes ExtUtils::Install
-	Check for NV inf. Fixes DateTime
-	* CC.pm (1.07): added -fslow-signals
+	Defer xpvmg->pv init to run-time < 5.10. Fixes MooseX::Types
+	Check for NV inf. Fixes compilation of DateTime
+	Defined PERL_CORE: Fxied Windows problems with setjmp undef'ed in XSUB.h
+	Added Win32 workaround for missing PL_do_undump
+	Stripped perl_ prefix from perl_get_cv, perl_call_pv, perl_call_method
+	* CC.pm (1.07): added -fslow-signals.
+	Disabled inlined pp_enter: Fails on empty cxstack. 
+	Backed out inlining of enterloop: GIMME_V fails on freebsd7
+	Remove strawberry PerlProc_setjmp definition, #define PERL_CORE fixed that
 	* Bytecode.pm (1.06): same NVX => xpad_cop_seq fix as in C.pm, added 2 new 
 	  bytecodes (cop_seq_low, cop_seq_high), fixed tests 9,10,12. Passes 
 	  all tests > 5.6 now.
@@ -22,7 +31,12 @@
 	  -s a, exitcode 0, ok, no warnings on stderr
 	* t/TESTS: added 38, failing on CC (Nick Koston).
 	added 39, failing everywhere.
-	* MANIFEST, *.pod: Moved conference pods to ramblings
+	* t/test.pl: refactor: Try to timeout on all tests (compiler and exec) if
+	  IPC::Run is installed
+	* MANIFEST, *.pod: Moved conference pods to ramblings,
+	removed lib/B/Asmdata.pm again, added t/qr_loaded_module.pm
+	* t/testm.sh, t/modules.pm: added, -t not working yet though
+	* t/b.t: $[ => $]
 
 1.18	2010-02-06 rurban
 	evaltry (test 12) still broken on most systems.
@@ -261,7 +275,7 @@
 
 1.04_33	2009-12-17 rurban
 	* t/cc*.t: skip some memory eating failing tests.
-	* MANIFEST: dummy lib/B/Asmdata.pm added to fix cpan smokes.
+	* MANIFEST: dummy lib/B/Asmdata.pm added to fix cpan smokes on BSD.
 	Thanks to Slaven Rezic.
 	* C.pm: fix tests 14,16,23 on >=5.10, missing AV magic for
 	  CV main::a, protect PVMG from SvPAD_OUR.

MANIFEST

@@ -1,5 +1,4 @@
 Artistic
-lib/B/Asmdata.pm
 lib/B/Assembler.pm
 lib/B/Bblock.pm
 lib/B/Bytecode.pm
@@ -79,16 +78,19 @@ t/c_o4.t
 t/cc.t
 t/cc_o1.t
 t/cc_o2.t
-t/o.t
+t/modules.pm
 t/modules.t
 t/mymodules
+t/o.t
+t/qr_loaded_module.pm
 t/stash.t
 t/TESTS
 t/testcore.t
 t/test.pl
 t/testplc.sh
 t/testc.sh
 t/testcc.sh
+t/testm.sh
 t/top100
 TESTS
 Todo

Makefile.PL

@@ -5,15 +5,17 @@ use 5.006;
 
 my $core = grep { $_ eq 'PERL_CORE=1' } @ARGV;
 
+# generate lib/B/Asmdata.pm beforehand
 system("$^X bytecode.pl");
 
 WriteMakefile(
     NAME	 => "B::C",
     VERSION_FROM => "lib/B/C.pm",
     PL_FILES   => { 'script/perlcc.PL'    => 'script/perlcc' },
     EXE_FILES  => [qw(script/perlcc script/cc_harness script/assemble script/disassemble)],
-    PREREQ_PM  => {'Opcodes' => '0',
-    #	          'B'          => '1.0901'
+    PREREQ_PM  => {'Opcodes'  => '0',
+		   'IPC::Run' => '0',
+		  #'B'        => '1.0901'
                   },
     'AUTHOR'   => 'Malcolm Beattie <mbeattie@sable.ox.ac.uk>, Reini Urban <perl-compiler@googlegroups.com>',
     'ABSTRACT' => 'Perl compiler',

lib/B/C.pm

@@ -1237,17 +1237,17 @@ sub B::PVNV::save {
   return $sym if defined $sym;
   my ( $savesym, $pvmax, $len, $pv ) = save_pv_or_rv($sv);
   my $val = $sv->NVX;
-  # For now the stringification works of NVX to two ints ok. But we might need
-  # to store it as { low, high }.
+  if ($sv->FLAGS & (SVf_NOK|SVp_NOK)) {
+    # it could be a double, or it could be 2 ints - union xpad_cop_seq
+    my $sval = sprintf("%g", $val);
+    $val = '0' if $sval =~ /(NAN|inf)$/i; # windows msvcrt (DateTime)
+    $val .= '.00' if $val =~ /^-?\d+$/;
+  } else {
+    $val = '0' if $val =~ /(NAN|inf)$/i; # windows msvcrt
+  }
   if ($PERL510) {
-    if ($sv->FLAGS & (SVf_NOK|SVp_NOK)) {
-      # it could be a double, or it could be 2 ints - union xpad_cop_seq
-      my $sval = sprintf("%g", $val);
-      $val = '0' if $sval =~ /(NAN|inf)$/i; # windows msvcrt
-      $val .= '.00' if $val =~ /^-?\d+$/;
-    } else {
-      $val = '0' if $val =~ /(NAN|inf)$/i; # windows msvcrt
-    }
+    # For now the stringification works of NVX to two ints ok. But we might need
+    # to store it as { low, high }.
     $xpvnvsect->comment('$val, $len, $pvmax, $sv->IVX');
     $xpvnvsect->add(
       sprintf( "{%s}, %u, %u, {%d}", $val, $len, $pvmax, $sv->IVX ) );    # ??
@@ -1388,8 +1388,16 @@ sub B::PVMG::save {
                          $xpvmgsect->index, $sv->REFCNT, $sv->FLAGS, $savesym));
   }
   else {
-    $xpvmgsect->add(sprintf("%s, %u, %u, %d, %s, 0, 0",
-			    $savesym, $len, $pvmax, $sv->IVX, $sv->NVX));
+    # cannot initialize this pointer static
+    if ($savesym =~ /&(PL|sv)/) { # (char*)&PL_sv_undef | (char*)&sv_list[%d]
+      $xpvmgsect->add(sprintf("%d, %u, %u, %d, %s, 0, 0",
+			      0, $len, $pvmax, $sv->IVX, $sv->NVX));
+      $init->add( sprintf( "xpvmg_list[%d].xpv_pv = $savesym;",
+			   $xpvmgsect->index ) );
+    } else {
+      $xpvmgsect->add(sprintf("%s, %u, %u, %d, %s, 0, 0",
+			      $savesym, $len, $pvmax, $sv->IVX, $sv->NVX));
+    }
     $svsect->add(sprintf("&xpvmg_list[%d], %lu, 0x%x",
 			 $xpvmgsect->index, $sv->REFCNT, $sv->FLAGS));
   }
@@ -1557,7 +1565,7 @@ sub B::RV::save {
         sprintf( "xrv_list[%d].xrv_rv = (SV*)%s;\n", $xrvsect->index, $rv ) );
     }
     # one more: bootstrapped XS CVs (test Class::MOP, no simple testcase yet)
-    elsif ( $rv =~ /\(perl_get_cv/ ) {
+    elsif ( $rv =~ /get_cv\(/ ) {
       $xrvsect->add("(SV*)Nullhv");
       $init->add(
         sprintf( "xrv_list[%d].xrv_rv = (SV*)%s;\n", $xrvsect->index, $rv ) );
@@ -1703,7 +1711,7 @@ sub B::CV::save {
     }
     warn sprintf( "stub for XSUB $cvstashname\:\:$cvname CV 0x%x\n", $$cv )
       if $debug{cv};
-    return qq/(perl_get_cv("$stashname\:\:$cvname",TRUE))/;
+    return qq/get_cv("$stashname\:\:$cvname",TRUE)/;
   }
   if ( $cvxsub && $cvname eq "INIT" ) {
     no strict 'refs';
@@ -2055,8 +2063,8 @@ sub B::GV::save {
       if ( $gvcv->XSUB && $name ne $origname ) {    #XSUB alias
         # must save as a 'stub' so newXS() has a CV to populate
         $init->add("{ CV *cv;");
-        $init->add("\tcv=perl_get_cv($origname,TRUE);");
-        $init->add("\tGvCV($sym)=cv;");
+        $init->add("\tcv = get_cv($origname,TRUE);");
+        $init->add("\tGvCV($sym) = cv;");
         $init->add("\tSvREFCNT_inc((SV *)cv);");
         $init->add("}");
       }
@@ -2644,6 +2652,7 @@ __EOGP
 
 sub output_boilerplate {
   print <<'EOT';
+#define PERL_CORE
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -2653,6 +2662,12 @@ sub output_boilerplate {
 #define Perl_pp_mapstart Perl_pp_grepstart
 #undef OP_MAPSTART
 #define OP_MAPSTART OP_GREPSTART
+
+/* Since 5.8.8 */
+#ifndef Newx
+#define Newx(v,n,t)    New(0,v,n,t)
+#endif
+
 #define XS_DynaLoader_boot_DynaLoader boot_DynaLoader
 EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
 
@@ -2753,6 +2768,9 @@ main(int argc, char **argv, char **env)
 
     PERL_SYS_INIT3(&argc,&argv,&env);
 
+#ifdef WIN32
+#define PL_do_undump 0
+#endif
     if (!PL_do_undump) {
 	my_perl = perl_alloc();
 	if (!my_perl)
@@ -2790,7 +2808,7 @@ EOT
 #else
 #define EXTRA_OPTIONS 4
 #endif /* ALLOW_PERL_OPTIONS */
-    New(0,fakeargv, argc + EXTRA_OPTIONS + 1, char *);
+    Newx(fakeargv, argc + EXTRA_OPTIONS + 1, char *);
     fakeargv[0] = argv[0];
     fakeargv[1] = "-e";
     fakeargv[2] = "";
@@ -2960,10 +2978,10 @@ EOT
       print "#ifdef USE_DYNAMIC_LOADING\n";
       warn "bootstrapping $stashname added to dl_init\n" if $verbose;
       if ( $xsub{$stashname} eq 'Dynamic' ) {
-        print qq/\tperl_call_method("bootstrap",G_DISCARD);\n/;
+        print qq/\tcall_method("bootstrap",G_DISCARD);\n/;
       }
       else {
-        print qq/\tperl_call_pv("XSLoader::load",G_DISCARD);\n/;
+        print qq/\tcall_pv("XSLoader::load",G_DISCARD);\n/;
       }
       print "#else\n";
       print "\tboot_$stashxsub(aTHX_ NULL);\n";

lib/B/CC.pm

@@ -173,17 +173,8 @@ sub save_runtime {
 
 sub output_runtime {
   my $ppdata;
-  print qq(#include "cc_runtime.h"\n);
-  # PerlProc_setjmp PerlProc_longjmp for Windows
+  print qq(\n#include "cc_runtime.h"\n);
   # CC coverage: 12, 32
-  print << '__EOF';
-#ifndef PerlProc_setjmp
-# define PerlProc_setjmp(b, n) Sigsetjmp((b), (n))
-# define PerlProc_longjmp(b, n) Siglongjmp((b), (n))
-#endif
-
-__EOF
-
 
   # Perls >=5.8.9 have a broken PP_ENTERTRY. See PERL_FLEXIBLE_EXCEPTIONS in cop.h
   # Fixed in CORE with 5.11.4
@@ -857,15 +848,21 @@ sub pp_const {
   return $op->next;
 }
 
-# coverage: 1-32
+# coverage: 1-39, fails in 33
 sub pp_nextstate {
   my $op = shift;
   $curcop->load($op);
   @stack = ();
   debug( sprintf( "%s:%d\n", $op->file, $op->line ) ) if $debug{lineno};
   debug( sprintf( "CopLABEL %s\n", $op->label ) ) if $op->label and $debug{cxstack};
   runtime("TAINT_NOT;\t/* nextstate */") unless $omit_taint;
+  #my $cxix  = $#cxstack;
+  # XXX What symptom I'm fighting here? test 33
+  #if ( $cxix >= 0 ) { # XXX
   runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;");
+  #} else {
+  #  runtime("sp = PL_stack_base;");
+  #}
   if ( $freetmps_each_bblock || $freetmps_each_loop ) {
     $need_freetmps = 1;
   }
@@ -1629,18 +1626,20 @@ sub pp_goto {
   return $op->next;
 }
 
-# coverage: 1-32
+# coverage: 1-39, c_argv.t 2
 sub pp_enter {
-  if ($inline_ops) {
+  # XXX fails with simple c_argv.t 2. no cxix. Disabled for now
+  if (0 and $inline_ops) {
     my $op = shift;
     warn "inlining enter\n" if $debug{op};
     $curcop->write_back if $curcop;
     if (!($op->flags & OPf_WANT)) {
-      if ( $#cxstack >= 0) {
+      my $cxix = $#cxstack;
+      if ( $cxix >= 0 ) {
         if ( $op->flags & OPf_SPECIAL ) {
           runtime "gimme = block_gimme();";
         } else {
-          runtime "cxstack[cxstack_ix].blk_gimme;";
+          runtime "gimme = cxstack[cxstack_ix].blk_gimme;";
         }
       } else {
         runtime "gimme = G_SCALAR;";
@@ -1927,9 +1926,11 @@ sub enterloop {
   $nextop->save;
   $lastop->save;
   $redoop->save;
-  if ($inline_ops and $op->name eq 'enterloop') {
+  if (0 and $inline_ops and $op->name eq 'enterloop') {
     warn "inlining enterloop\n" if $debug{op};
-    runtime "gimme = GIMME_V;";
+    # XXX = GIMME_V fails on freebsd7 5.8.8 (28)
+    # = block_gimme() fails on the rest, but passes on freebsd7
+    runtime "gimme = GIMME_V;"; # XXX
     if ($PERL511) {
       runtime('ENTER_with_name("loop1");',
               'SAVETMPS;',

t/modules.pm

@@ -7,13 +7,14 @@ BEGIN {
 require "test.pl";
 use Test::More;
 use Cwd;
-
-my %modules;
-my $log = 0;
-my $keep = '';
-my @modules;
-eval { require IPC::Run; };
-my $have_IPC_Run = defined $IPC::Run::VERSION;
+use Exporter;
+our @ISA     = qw(Exporter);
+our @EXPORT = qw(%modules $have_IPC_Run $keep
+		 percent log_diag log_pass log_err get_module_list random_sublist
+		);
+our (%modules);
+our $log = 0;
+our $keep = '';
 
 sub percent {
   $_[1] ? sprintf("%0.1f%%", $_[0]*100/$_[1]) : '';