Re:perlcc -e 'my $x = shift; print +($x ?...' failure

To: perl5-porters@perl.org
Cc: rmb1@cise.npl.co.uk, nick@ni-s.u-net.com
Message-ID: <MLIST_19981210061651.29891.qmail@hotmail.com>

(Nick's part was applied earlier, in change #2460)

p4raw-link: @2460 on //depot/cfgperl: f2b52f348dbc295b553473d1499a3cb8ae7c7ba4

p4raw-id: //depot/cfgperl@2524

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 40583bd..baf6def 100644 (file)
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -1244,6 +1244,7 @@ sub walkpackages
 sub save_unused_subs 
 {
  no strict qw(refs);
+ &descend_marked_unused;
  warn "Prescan\n";
  walkpackages(\%{"main::"}, sub { should_save($_[0]); return 1 });
  warn "Saving methods\n";
@@ -1263,12 +1264,15 @@ sub save_context
                "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));");
 }
 
+sub descend_marked_unused {
+    foreach my $pack (keys %unused_sub_packages)
+    {
+       mark_package($pack);
+    }
+}
+ 
 sub save_main {
     warn "Starting compile\n";
-    foreach my $pack (keys %unused_sub_packages)
-     {
-      mark_package($pack);
-     }
     warn "Walking tree\n";
     walkoptree(main_root, "save");
     warn "done main optree, walking symtable for extras\n" if $debug_cv;

diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index 14c70fe..391a787 100644 (file)
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -73,11 +73,6 @@ BEGIN {
     }
 }
 
-my @unused_sub_packages; # list of packages (given by -u options) to search
-                        # explicitly and save every sub we find there, even
-                        # if apparently unused (could be only referenced from
-                        # an eval "" or from a $SIG{FOO} = "bar").
-
 my ($module_name);
 my ($debug_op, $debug_stack, $debug_cxstack, $debug_pad, $debug_runtime,
     $debug_shadow, $debug_queue, $debug_lineno, $debug_timings);
@@ -200,7 +195,7 @@ sub top_int { @stack ? $stack[-1]->as_int : "TOPi" }
 sub top_double { @stack ? $stack[-1]->as_double : "TOPn" }
 sub top_numeric { @stack ? $stack[-1]->as_numeric : "TOPn" }
 sub top_sv { @stack ? $stack[-1]->as_sv : "TOPs" }
-sub top_bool { @stack ? $stack[-1]->as_numeric : "SvTRUE(TOPs)" }
+sub top_bool { @stack ? $stack[-1]->as_bool : "SvTRUE(TOPs)" }
 
 sub pop_int { @stack ? (pop @stack)->as_int : "POPi" }
 sub pop_double { @stack ? (pop @stack)->as_double : "POPn" }
@@ -208,7 +203,7 @@ sub pop_numeric { @stack ? (pop @stack)->as_numeric : "POPn" }
 sub pop_sv { @stack ? (pop @stack)->as_sv : "POPs" }
 sub pop_bool {
     if (@stack) {
-       return ((pop @stack)->as_numeric);
+       return ((pop @stack)->as_bool);
     } else {
        # Careful: POPs has an auto-decrement and SvTRUE evaluates
        # its argument more than once.
@@ -1494,7 +1489,7 @@ sub compile {
        } elsif ($opt eq "m") {
            $arg ||= shift @options;
            $module = $arg;
-           push(@unused_sub_packages, $arg);
+           mark_unused($arg,undef);
        } elsif ($opt eq "p") {
            $arg ||= shift @options;
            $patchlevel = $arg;

diff --git a/ext/B/B/Stackobj.pm b/ext/B/B/Stackobj.pm
index eea966c..3f7f0f7 100644 (file)
--- a/ext/B/B/Stackobj.pm
+++ b/ext/B/B/Stackobj.pm
@@ -81,6 +81,17 @@ sub as_numeric {
     return $obj->{type} == T_INT ? $obj->as_int : $obj->as_double;
 }
 
+sub as_bool {
+       my $obj=shift;
+       if ($obj->{flags} & VALID_INT ){
+               return $obj->{iv}; 
+       }
+       if ($obj->{flags} & VALID_DOUBLE ){
+               return $obj->{nv}; 
+       }
+       return sprintf("(SvTRUE(%s))", $obj->as_sv) ;
+}
+
 #
 # Debugging methods
 #