applied patch, fixed one more leak, tweaked whitespace bugs

	From: Guy Decoux <decoux@moulon.inra.fr>
	(via)
	Date: Fri, 26 Jun 1998 09:59:32 -0400
	From: "Chunhui Teng" <cteng@nortel.ca>
	Message-Id: <199806261359.JAA02393@bmers357.nortel.ca>
	Subject: Memory leak in Perl 5.004 and the fix

p4raw-id: //depot/perl@1256

diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs
index 559d384..a9fea04 100644 (file)
--- a/ext/Opcode/Opcode.xs
+++ b/ext/Opcode/Opcode.xs
@@ -5,6 +5,7 @@
 /* maxo shouldn't differ from MAXO but leave room anyway (see BOOT:)   */
 #define OP_MASK_BUF_SIZE (MAXO + 100)
 
+/* XXX op_named_bits and opset_all are never freed */
 static HV *op_named_bits;      /* cache shared for whole process       */
 static SV *opset_all;          /* mask with all bits set               */
 static IV  opset_len;          /* length of opmasks in bytes           */
@@ -21,6 +22,8 @@ static SV  *get_op_bitspec _((char *opname, STRLEN len, int fatal));
  * It is first loaded with the name and number of each perl operator.
  * Then the builtin tags :none and :all are added.
  * Opcode.pm loads the standard optags from __DATA__
+ * XXX leak-alert: data allocated here is never freed, call this
+ *     at most once
  */
 
 static void
@@ -235,7 +238,7 @@ _safe_call_sv(Package, mask, codesv)
     char *     Package
     SV *       mask
     SV *       codesv
-    PPCODE:
+PPCODE:
     char op_mask_buf[OP_MASK_BUF_SIZE];
     GV *gv;
 
@@ -272,11 +275,11 @@ verify_opset(opset, fatal = 0)
 void
 invert_opset(opset)
     SV *opset
-    CODE:
+CODE:
     {
     char *bitmap;
     STRLEN len = opset_len;
-    opset = new_opset(opset);  /* verify and clone opset */
+    opset = sv_2mortal(new_opset(opset));      /* verify and clone opset */
     bitmap = SvPVX(opset);
     while(len-- > 0)
        bitmap[len] = ~bitmap[len];
@@ -291,7 +294,7 @@ void
 opset_to_ops(opset, desc = 0)
     SV *opset
     int        desc
-    PPCODE:
+PPCODE:
     {
     STRLEN len;
     int i, j, myopcode;
@@ -310,12 +313,12 @@ opset_to_ops(opset, desc = 0)
 
 void
 opset(...)
-    CODE:
+CODE:
     int i, j;
     SV *bitspec, *opset;
     char *bitmap;
     STRLEN len, on;
-    opset = new_opset(Nullsv);
+    opset = sv_2mortal(new_opset(Nullsv));
     bitmap = SvPVX(opset);
     for (i = 0; i < items; i++) {
        char *opname;
@@ -340,11 +343,11 @@ opset(...)
 void
 permit_only(safe, ...)
     SV *safe
-    ALIAS:
+ALIAS:
        permit    = 1
        deny_only = 2
        deny      = 3
-    CODE:
+CODE:
     int i, on;
     SV *bitspec, *mask;
     char *bitmap, *opname;
@@ -354,8 +357,9 @@ permit_only(safe, ...)
        croak("Not a Safe object");
     mask = *hv_fetch((HV*)SvRV(safe), "Mask",4, 1);
     if (ONLY_THESE)    /* *_only = new mask, else edit current */
-        sv_setsv(mask, new_opset(PERMITING ? opset_all : Nullsv));
-    else verify_opset(mask,1); /* croaks */
+       sv_setsv(mask, sv_2mortal(new_opset(PERMITING ? opset_all : Nullsv)));
+    else
+       verify_opset(mask,1); /* croaks */
     bitmap = SvPVX(mask);
     for (i = 1; i < items; i++) {
        on = PERMITING ? 0 : 1;         /* deny = mask bit on   */
@@ -377,7 +381,7 @@ permit_only(safe, ...)
 
 void
 opdesc(...)
-    PPCODE:
+PPCODE:
     int i, myopcode;
     STRLEN len;
     SV **args;
@@ -415,7 +419,7 @@ void
 define_optag(optagsv, mask)
     SV *optagsv
     SV *mask
-    CODE:
+CODE:
     STRLEN len;
     char *optag = SvPV(optagsv, len);
     put_op_bitspec(optag, len, mask); /* croaks */
@@ -424,24 +428,24 @@ define_optag(optagsv, mask)
 
 void
 empty_opset()
-    CODE:
+CODE:
     ST(0) = sv_2mortal(new_opset(Nullsv));
 
 void
 full_opset()
-    CODE:
+CODE:
     ST(0) = sv_2mortal(new_opset(opset_all));
 
 void
 opmask_add(opset)
     SV *opset
-    PREINIT:
+PREINIT:
     if (!op_mask)
        Newz(0, op_mask, maxo, char);
 
 void
 opcodes()
-    PPCODE:
+PPCODE:
     if (GIMME == G_ARRAY) {
        croak("opcodes in list context not yet implemented"); /* XXX */
     }
@@ -451,7 +455,7 @@ opcodes()
 
 void
 opmask()
-    CODE:
+CODE:
     ST(0) = sv_2mortal(new_opset(Nullsv));
     if (op_mask) {
        char *bitmap = SvPVX(ST(0));

diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm
index c9d7416..940a972 100644 (file)
--- a/ext/Opcode/Safe.pm
+++ b/ext/Opcode/Safe.pm
@@ -53,11 +53,11 @@ sub new {
 
 sub DESTROY {
     my $obj = shift;
-    $obj->erase if $obj->{Erase};
+    $obj->erase('DESTROY') if $obj->{Erase};
 }
 
 sub erase {
-    my $obj= shift;
+    my ($obj, $action) = @_;
     my $pkg = $obj->root();
     my ($stem, $leaf);
 
@@ -73,18 +73,22 @@ sub erase {
     #warn " stem_symtab hash ".scalar(%$stem_symtab)."\n";
        # ", join(', ', %$stem_symtab),"\n";
 
-    delete $stem_symtab->{$leaf};
+#    delete $stem_symtab->{$leaf};
 
-#    my $leaf_glob   = $stem_symtab->{$leaf};
-#    my $leaf_symtab = *{$leaf_glob}{HASH};
+    my $leaf_glob   = $stem_symtab->{$leaf};
+    my $leaf_symtab = *{$leaf_glob}{HASH};
 #    warn " leaf_symtab ", join(', ', %$leaf_symtab),"\n";
-#    %$leaf_symtab = ();
+    %$leaf_symtab = ();
     #delete $leaf_symtab->{'__ANON__'};
     #delete $leaf_symtab->{'foo'};
     #delete $leaf_symtab->{'main::'};
 #    my $foo = undef ${"$stem\::"}{"$leaf\::"};
 
-    $obj->share_from('main', $default_share);
+    if ($action and $action eq 'DESTROY') {
+        delete $stem_symtab->{$leaf};
+    } else {
+        $obj->share_from('main', $default_share);
+    }
     1;
 }