applied suggested patch, modulo bogus hunk

	Message-ID: <19990311154027.25891.qmail@hotmail.com>
	Subject: [PATCH 5.005_56] Minor fixes in perlcc

p4raw-id: //depot/perl@3142

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 759b9cd..302b790 100644 (file)
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -748,45 +748,45 @@ sub B::GV::save {
 #      warn "GV::save saving subfields\n"; # debug
        my $gvsv = $gv->SV;
        if ($$gvsv) {
+           $gvsv->save;
            $init->add(sprintf("GvSV($sym) = s\\_%x;", $$gvsv));
 #          warn "GV::save \$$name\n"; # debug
-           $gvsv->save;
        }
        my $gvav = $gv->AV;
        if ($$gvav) {
+           $gvav->save;
            $init->add(sprintf("GvAV($sym) = s\\_%x;", $$gvav));
 #          warn "GV::save \@$name\n"; # debug
-           $gvav->save;
        }
        my $gvhv = $gv->HV;
        if ($$gvhv) {
+           $gvhv->save;
            $init->add(sprintf("GvHV($sym) = s\\_%x;", $$gvhv));
 #          warn "GV::save \%$name\n"; # debug
-           $gvhv->save;
        }
        my $gvcv = $gv->CV;
        if ($$gvcv && !$skip_cv) {
+           $gvcv->save;
            $init->add(sprintf("GvCV($sym) = (CV*)s\\_%x;", $$gvcv));
 #          warn "GV::save &$name\n"; # debug
-           $gvcv->save;
        }
        my $gvfilegv = $gv->FILEGV;
        if ($$gvfilegv) {
+           $gvfilegv->save;
            $init->add(sprintf("GvFILEGV($sym) = (GV*)s\\_%x;",$$gvfilegv));
 #          warn "GV::save GvFILEGV(*$name)\n"; # debug
-           $gvfilegv->save;
        }
        my $gvform = $gv->FORM;
        if ($$gvform) {
+           $gvform->save;
            $init->add(sprintf("GvFORM($sym) = (CV*)s\\_%x;", $$gvform));
 #          warn "GV::save GvFORM(*$name)\n"; # debug
-           $gvform->save;
        }
        my $gvio = $gv->IO;
        if ($$gvio) {
+           $gvio->save;
            $init->add(sprintf("GvIOp($sym) = s\\_%x;", $$gvio));
 #          warn "GV::save GvIO(*$name)\n"; # debug
-           $gvio->save;
        }
     }
     return $sym;
@@ -1226,7 +1226,8 @@ sub should_save
  if (exists $unused_sub_packages{$package})
   {
    # warn "Cached $package is ".$unused_sub_packages{$package}."\n"; 
-   return $unused_sub_packages{$package} 
+   delete_unsaved_hashINC($package) unless  $unused_sub_packages{$package} ;
+   return $unused_sub_packages{$package}; 
   }
  # Omit the packages which we use (and which cause grief
  # because of fancy "goto &$AUTOLOAD" stuff).
@@ -1234,6 +1235,7 @@ sub should_save
  if ($package eq "FileHandle" || $package eq "Config" || 
      $package eq "SelectSaver" || $package =~/^(B|IO)::/) 
   {
+   delete_unsaved_hashINC($package);
    return $unused_sub_packages{$package} = 0;
   }
  # Now see if current package looks like an OO class this is probably too strong.
@@ -1245,9 +1247,16 @@ sub should_save
      return mark_package($package);
     }
   }
+ delete_unsaved_hashINC($package);
  return $unused_sub_packages{$package} = 0;
 }
-
+sub delete_unsaved_hashINC{
+       my $packname=shift;
+       $packname =~ s/\:\:/\//g;
+       $packname .= '.pm';
+       warn "deleting $packname" if $INC{$packname} ;# debug
+       delete $INC{$packname};
+}
 sub walkpackages 
 {
  my ($symref, $recurse, $prefix) = @_;
@@ -1300,7 +1309,6 @@ sub descend_marked_unused {
        mark_package($pack);
     }
 }
-
  
 sub save_main {
     warn "Starting compile\n";

diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index d44a119..f6f4f0f 100644 (file)
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -1107,7 +1107,7 @@ sub pp_range {
     }
     write_back_lexicals();
     write_back_stack();
-    if (!($flags & OPf_WANT_LIST)) {
+    unless (($flags & OPf_WANT)== OPf_WANT_LIST) {
        # We need to save our UNOP structure since pp_flop uses
        # it to find and adjust out targ. We don't need it ourselves.
        $op->save;
@@ -1124,7 +1124,7 @@ sub pp_flip {
     if (!($flags & OPf_WANT)) {
        error("context of flip unknown at compile-time");
     }
-    if ($flags & OPf_WANT_LIST) {
+    if (($flags & OPf_WANT)==OPf_WANT_LIST) {
        return $op->first->false;
     }
     write_back_lexicals();
@@ -1418,12 +1418,13 @@ sub cc_main {
     my $curpad_nam  = $comppadlist[0]->save;
     my $curpad_sym  = $comppadlist[1]->save;
     my $init_av     = init_av->save; 
-    my $inc_hv      = svref_2object(\%INC)->save;
-    my $inc_av      = svref_2object(\@INC)->save;
     my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
+    # Do save_unused_subs before saving inc_hv
     save_unused_subs();
     cc_recurse();
 
+    my $inc_hv      = svref_2object(\%INC)->save;
+    my $inc_av      = svref_2object(\@INC)->save;
     return if $errors;
     if (!defined($module)) {
        $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),

diff --git a/utils/perlcc.PL b/utils/perlcc.PL
index 2ea822b..7aca1d8 100644 (file)
--- a/utils/perlcc.PL
+++ b/utils/perlcc.PL
@@ -314,10 +314,10 @@ sub _ccharness
     }
 
     my @sharedobjects = _getSharedObjects($sourceprog); 
-    my $dynaloader="$Config{'installarchlib'}/auto/DynaLoader/DynaLoader.a";
-
+    my $dynaloader = "$Config{'installarchlib'}/auto/DynaLoader/DynaLoader.a";
+    my $optimize = $Config{'optimize'} =~ /-O\d/ ? '' : $Config{'optimize'};
     my $cccmd = 
-        "$Config{cc} @Config{qw(ccflags optimize)} $incdir @sharedobjects @args $dynaloader $linkargs";
+        "$Config{cc} @Config{qw(ccflags)} $optimize $incdir @sharedobjects @args $dynaloader $linkargs";
 
 
     _print ("$cccmd\n", 36);