more Compiler patches from Vishal Bhatia <vishalb@my-dejanews.com>

	Date: Tue, 27 Apr 1999 23:47:24 PDT
	Message-ID: <19990428064724.95244.qmail@hotmail.com>
	Subject: [PATCH 5.005_56] Saving Tied hashes ( C.pm)
	--
	Date: Thu, 29 Apr 1999 18:21:06 -0700
	Message-ID: <GEFPBFDJADFJBAAA@my-dejanews.com>
	Subject: [PATCH 5.005_56] double constants ( C.pm)
	--
	Date: Mon, 03 May 1999 20:21:31 PDT
	Message-ID: <19990504032131.81113.qmail@hotmail.com>
	Subject: [PATCH 5.005_56] Overloading implementation ( Compiler)
	--
	Date: Thu, 06 May 1999 17:57:09 -0700
	Message-ID: <FCJELBLAJBOBAAAA@my-dejanews.com>
	Subject: Stash.pm

p4raw-id: //depot/perl@3359

diff --git a/ext/B/B.pm b/ext/B/B.pm
index f864883..0bfceaf 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -11,7 +11,7 @@ require Exporter;
 @ISA = qw(Exporter DynaLoader);
 @EXPORT_OK = qw(byteload_fh byteload_string minus_c ppname
                class peekop cast_I32 cstring cchar hash threadsv_names
-               main_root main_start main_cv svref_2object opnumber
+               main_root main_start main_cv svref_2object opnumber amagic_generation
                walkoptree walkoptree_slow walkoptree_exec walksymtable
                parents comppadlist sv_undef compile_stats timing_info init_av);
 sub OPf_KIDS ();
@@ -750,6 +750,10 @@ Returns the SV object corresponding to the C variable C<sv_yes>.
 
 Returns the SV object corresponding to the C variable C<sv_no>.
 
+=item amagic_generation
+
+Returns the SV object corresponding to the C variable C<amagic_generation>.
+
 =item walkoptree(OP, METHOD)
 
 Does a tree-walk of the syntax tree based at OP and calls METHOD on

diff --git a/ext/B/B.xs b/ext/B/B.xs
index dd50d97..466091d 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -454,6 +454,7 @@ BOOT:
 #define B_init_av()    PL_initav
 #define B_main_root()  PL_main_root
 #define B_main_start() PL_main_start
+#define B_amagic_generation()  PL_amagic_generation
 #define B_comppadlist()        (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv))
 #define B_sv_undef()   &PL_sv_undef
 #define B_sv_yes()     &PL_sv_yes
@@ -471,6 +472,9 @@ B_main_root()
 B::OP
 B_main_start()
 
+long 
+B_amagic_generation()
+
 B::AV
 B_comppadlist()
 

diff --git a/ext/B/B/Bblock.pm b/ext/B/B/Bblock.pm
index cb007ff..14001b3 100644 (file)
--- a/ext/B/B/Bblock.pm
+++ b/ext/B/B/Bblock.pm
@@ -21,8 +21,8 @@ sub mark_leader {
 sub find_leaders {
     my ($root, $start) = @_;
     $bblock = {};
-    mark_leader($start);
-    walkoptree($root, "mark_if_leader");
+    mark_leader($start) if ( ref $start ne "B::NULL" );
+    walkoptree($root, "mark_if_leader") if ((ref $root) ne "B::NULL") ;
     return $bblock;
 }
 
@@ -103,6 +103,12 @@ sub B::LISTOP::mark_if_leader {
     mark_leader($op->next);
 }
 
+sub B::LISTOP::mark_if_leader {
+    my $op = shift;
+    mark_leader($op->first);
+    mark_leader($op->next);
+}
+
 sub B::PMOP::mark_if_leader {
     my $op = shift;
     if ($op->ppaddr ne "pp_pushre") {

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index ec39de2..4aa80a1 100644 (file)
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -49,7 +49,7 @@ use Exporter ();
 
 use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
         class cstring cchar svref_2object compile_stats comppadlist hash
-        threadsv_names main_cv init_av opnumber
+        threadsv_names main_cv init_av opnumber amagic_generation
         AVf_REAL HEf_SVKEY);
 use B::Asmdata qw(@specialsv_name);
 
@@ -401,7 +401,9 @@ sub B::NV::save {
     my ($sv) = @_;
     my $sym = objsym($sv);
     return $sym if defined $sym;
-    $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->IVX, $sv->NVX));
+    my $val= $sv->NVX;
+    $val .= '.00' if $val =~ /^-?\d+$/;
+    $xpvnvsect->add(sprintf("0, 0, 0, %d, %s", $sv->IVX, $val));
     $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
                         $xpvnvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
     return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
@@ -453,8 +455,10 @@ sub B::PVNV::save {
     $pv = '' unless defined $pv;
     my $len = length($pv);
     my ($pvsym, $pvmax) = savepv($pv);
+    my $val= $sv->NVX;
+    $val .= '.00' if $val =~ /^-?\d+$/;
     $xpvnvsect->add(sprintf("%s, %u, %u, %d, %s",
-                           $pvsym, $len, $pvmax, $sv->IVX, $sv->NVX));
+                           $pvsym, $len, $pvmax, $sv->IVX, $val));
     $svsect->add(sprintf("&xpvnv_list[%d], %lu, 0x%x",
                         $xpvnvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
     if (!$pv_copy_on_grow) {
@@ -524,6 +528,7 @@ sub B::PVMG::save_magic {
     my ($sv) = @_;
     #warn sprintf("saving magic for %s (0x%x)\n", class($sv), $$sv); # debug
     my $stash = $sv->SvSTASH;
+    $stash->save;
     if ($$stash) {
        warn sprintf("xmg_stash = %s (0x%x)\n", $stash->NAME, $$stash)
            if $debug_mg;
@@ -542,6 +547,7 @@ sub B::PVMG::save_magic {
                         class($sv), $$sv, class($obj), $$obj,
                         cchar($type), cstring($ptr));
        }
+       $obj->save;
        if ($len == HEf_SVKEY){
                #The pointer is an SV*
                $ptrsv=svref_2object($ptr)->save;
@@ -884,6 +890,7 @@ sub B::HV::save {
        }
        $init->add("}");
     }
+    $hv->save_magic();
     return savesym($hv, "(HV*)&sv_list[$sv_list_index]");
 }
 
@@ -1297,11 +1304,13 @@ sub save_context
  my $curpad_sym = (comppadlist->ARRAY)[1]->save;
  my $inc_hv     = svref_2object(\%INC)->save;
  my $inc_av     = svref_2object(\@INC)->save;
+ my $amagic_generate= amagic_generation;          
  $init->add(   "PL_curpad = AvARRAY($curpad_sym);",
               "GvHV(PL_incgv) = $inc_hv;",
               "GvAV(PL_incgv) = $inc_av;",
                "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
-               "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));");
+               "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));",
+               "PL_amagic_generation= $amagic_generate;" );
 }
 
 sub descend_marked_unused {

diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index 143ae41..649f6e1 100644 (file)
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -8,7 +8,7 @@
 package B::CC;
 use strict;
 use B qw(main_start main_root class comppadlist peekop svref_2object
-       timing_info init_av  sv_undef
+       timing_info init_av sv_undef amagic_generation 
        OPf_WANT_LIST OPf_WANT OPf_MOD OPf_STACKED OPf_SPECIAL
        OPpASSIGN_BACKWARDS OPpLVAL_INTRO OPpDEREF_AV OPpDEREF_HV
        OPpDEREF OPpFLIP_LINENUM G_ARRAY G_SCALAR    
@@ -1424,7 +1424,12 @@ sub cc {
        warn sprintf("Basic block analysis at %s\n", timing_info);
     }
     $leaders = find_leaders($root, $start);
-    @bblock_todo = ($start, values %$leaders);
+    my @leaders= keys %$leaders; 
+    if ($#leaders > -1) { 
+       @bblock_todo = ($start, values %$leaders) ;
+    } else{
+       runtime("return PL_op?PL_op->op_next:0;");
+    }
     if ($debug_timings) {
        warn sprintf("Compilation at %s\n", timing_info);
     }
@@ -1488,6 +1493,7 @@ sub cc_main {
 
     my $inc_hv      = svref_2object(\%INC)->save;
     my $inc_av      = svref_2object(\@INC)->save;
+    my $amagic_generate= amagic_generation;
     return if $errors;
     if (!defined($module)) {
        $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
@@ -1498,6 +1504,7 @@ sub cc_main {
                   "GvAV(PL_incgv) = $inc_av;",
                   "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
                   "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));",
+                  "PL_amagic_generation= $amagic_generate;",
                     );
                  
     }

diff --git a/ext/B/B/Stash.pm b/ext/B/B/Stash.pm
index 42c8bc0..828ffac 100644 (file)
--- a/ext/B/B/Stash.pm
+++ b/ext/B/B/Stash.pm
@@ -11,12 +11,15 @@ END {
 }
 sub scan{
        my $start=shift;
+       my $prefix=shift;
+       $prefix = '' unless defined $prefix;
        my @return;
        foreach my $key ( keys %{$start}){
+#              print $prefix,$key,"\n";
                if ($key =~ /::$/){
                        unless ($start  eq ${$start}{$key} or $key eq "B::" ){
-                               push @return, $key ;
-                               foreach my $subscan ( scan(${$start}{$key})){
+                               push @return, $key unless omit($prefix.$key);
+                               foreach my $subscan ( scan(${$start}{$key},$prefix.$key)){
                                        push @return, "$key".$subscan;  
                                }
                        }
@@ -24,6 +27,16 @@ sub scan{
        }
        return @return;
 }
-1;
-
+sub omit{
+       my $module = shift;
+       my %omit=("DynaLoader::" => 1 , "CORE::" => 1 ,
+               "CORE::GLOBAL::" => 1, "UNIVERSAL::" => 1 );
+       return 1 if $omit{$module};
+       if ($module eq "IO::" or $module eq "IO::Handle::"){
+               $module =~ s/::/\//g;   
+               return 1 unless  $INC{$module};
+       }
 
+       return 0;
+}
+1;

diff --git a/t/harness b/t/harness
index 88bcb38..174b318 100644 (file)
--- a/t/harness
+++ b/t/harness
@@ -19,15 +19,43 @@ $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v';
 @tests = <base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t lib/*.t> unless @tests;
 
 Test::Harness::runtests @tests;
-
-%infinite = ('comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 );
+exit(0) unless -e "../testcompile";
+
+%infinite =   qw(
+               op/bop.t                1
+               lib/hostname.t          1
+               );
+#fudge DATA for now.
+%datahandle = qw(
+               lib/bigint.t            1
+               lib/bigintpm.t          1
+               lib/bigfloat.t          1
+               lib/bigfloatpm.t        1
+               );
+
+my $dhwrapper = <<'EOT';
+open DATA,"<".__FILE__;
+until (($_=<DATA>) =~ /^__END__/) {};
+EOT
 
 @tests = grep (!$infinite{$_}, @tests);
-
-if (-e "../testcompile") 
-{ 
-       print "The tests ", join(' ', keys(%infinite)), 
-                                                       " generate infinite loops! Skipping!\n";
-
-       $ENV{'COMPILE_TEST'} = 1; Test::Harness::runtests @tests; 
+@tests = map {
+                my $new = $_;
+                if ($datahandle{$_}) {
+                    $new .= '.t';
+                    local(*F, *T);
+                    open(F,"<$_") or die "Can't open $_: $!";
+                    open(T,">$new") or die "Can't open $new: $!";
+                    print T $dhwrapper, <F>;
+                    close F;
+                    close T;
+                }
+                $new;
+            } @tests;
+
+print "The tests ", join(' ', keys(%infinite)), 
+       " generate infinite loops! Skipping!\n";
+$ENV{'COMPILE_TEST'} = 1; Test::Harness::runtests @tests; 
+foreach (keys %datahandle) {
+     unlink "$_.t";
 }