[WWcvs] pg: Formula objects and Context objects contain reference loops, which prevent them from being freed properly by perl when they

[dpvc v. a. <we...@ma...>]

Log Message:
-----------
Formula objects and Context objects contain reference loops, which
prevent them from being freed properly by perl when they are no longer
needed.  This is a source of an important memory leak in WeBWorK.  The
problem has been fixed by using Scalar::Util::weaken for these
recursive references, so these objects can be freed properly when they
go out of scope.  This should cause an improvement in the memory usage
of the httpd child processes.

Modified Files:
--------------
    pg/lib/Parser:
        BOP.pm
        Complex.pm
        Constant.pm
        Function.pm
        Item.pm
        List.pm
        Number.pm
        String.pm
        UOP.pm
        Value.pm
        Variable.pm
    pg/lib/Value:
        Formula.pm
    pg/lib/Value/Context:
        Data.pm

Revision Data
-------------
Index: Number.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Number.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -Llib/Parser/Number.pm -Llib/Parser/Number.pm -u -r1.16 -r1.17
--- lib/Parser/Number.pm
+++ lib/Parser/Number.pm
@@ -21,6 +21,7 @@
     type => $Value::Type{number}, isConstant => 1,
     ref => $ref, equation => $equation,
   }, $class;
+  $num->weaken;
   my $x = $num->Package("Real")->make($context,$value);
   $num->{isOne}  = 1 if $x eq 1;
   $num->{isZero} = 1 if $value == 0;
Index: Complex.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Complex.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -Llib/Parser/Complex.pm -Llib/Parser/Complex.pm -u -r1.11 -r1.12
--- lib/Parser/Complex.pm
+++ lib/Parser/Complex.pm
@@ -20,6 +20,7 @@
     value => $value, type => $Value::Type{complex}, isConstant => 1,
     ref => $ref, equation => $equation,
   }, $class;
+  $num->weaken;
   my $z = $self->Package("Complex",$context)->make($context,@{$value});
   $num->{isOne}  = 1 if ($z cmp 1) == 0;
   $num->{isZero} = 1 if $z == 0;
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Value.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -Llib/Parser/Value.pm -Llib/Parser/Value.pm -u -r1.20 -r1.21
--- lib/Parser/Value.pm
+++ lib/Parser/Value.pm
@@ -37,6 +37,7 @@
     value => $value, type => $type, isConstant => 1,
     ref => $ref, equation => $equation,
   }, $class;
+  $c->weaken;
   $c->check;
   return $c;
 }
Index: List.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/List.pm,v
retrieving revision 1.23
retrieving revision 1.24
diff -Llib/Parser/List.pm -Llib/Parser/List.pm -u -r1.23 -r1.24
--- lib/Parser/List.pm
+++ lib/Parser/List.pm
@@ -48,6 +48,7 @@
     coords => $coords, type => $type, open => $open, close => $close,
     paren => $paren, equation => $equation, isConstant => $constant
   }, $context->{lists}{$type->{name}}{class};
+  $list->weaken;
 
   my $zero = 1;
   foreach my $x (@{$coords}) {$zero = 0, last unless $x->{isZero}}
Index: Constant.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Constant.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -Llib/Parser/Constant.pm -Llib/Parser/Constant.pm -u -r1.14 -r1.15
--- lib/Parser/Constant.pm
+++ lib/Parser/Constant.pm
@@ -23,6 +23,7 @@
     name => $name, type => $type, def => $const,
     ref => $ref, equation => $equation
   }, $class;
+  $c->weaken;
   $c->{isConstant} = 1 if $const->{isConstant};
   return $c;
 }
Index: String.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/String.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -Llib/Parser/String.pm -Llib/Parser/String.pm -u -r1.13 -r1.14
--- lib/Parser/String.pm
+++ lib/Parser/String.pm
@@ -26,6 +26,7 @@
     value => $value, type => $Value::Type{string}, isConstant => 1,
     def => $def, ref => $ref, equation => $equation,
   }, $class;
+  $str->weaken;
   $str->{isInfinite} = 1 if ($def->{infinite});
   $str->{isInfinity} = 1 if ($def->{infinite} && !$def->{negative});
   $str->{isNegativeInfinity} = 1 if ($def->{infinite} && $def->{negative});
Index: BOP.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -Llib/Parser/BOP.pm -Llib/Parser/BOP.pm -u -r1.21 -r1.22
--- lib/Parser/BOP.pm
+++ lib/Parser/BOP.pm
@@ -30,6 +30,7 @@
     bop => $bop, lop => $lop, rop => $rop,
     def => $def, ref => $ref, equation => $equation,
   }, $def->{class};
+  $BOP->weaken;
   $BOP->{isConstant} = 1 if ($lop->{isConstant} && $rop->{isConstant});
   $BOP->_check;
   $BOP = $BOP->Item("Value")->new($equation,[$BOP->eval])
Index: Variable.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Variable.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -Llib/Parser/Variable.pm -Llib/Parser/Variable.pm -u -r1.11 -r1.12
--- lib/Parser/Variable.pm
+++ lib/Parser/Variable.pm
@@ -28,10 +28,12 @@
     if $variables-> {$name}{parameter} && $equation->{context}{flags}{no_parameters};
   $equation->{variables}{$name} = 1;
   my $def = $variables->{$name};
-  bless {
+  my $v = bless {
     name => $name, def => $def, type => $def->{type},
     ref => $ref, equation => $equation
   }, $class;
+  $v->weaken;
+  return $v;
 }
 
 #
Index: Function.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -Llib/Parser/Function.pm -Llib/Parser/Function.pm -u -r1.24 -r1.25
--- lib/Parser/Function.pm
+++ lib/Parser/Function.pm
@@ -19,6 +19,7 @@
     name => $name, params => $params,
     def => $def, ref => $ref, equation => $equation,
   }, $def->{class};
+  $fn->weaken;
   $fn->{isConstant} = $constant;
   $fn->_check;
   return $fn->Item("Value")->new($equation,[$fn->eval])
Index: Item.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Item.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -Llib/Parser/Item.pm -Llib/Parser/Item.pm -u -r1.15 -r1.16
--- lib/Parser/Item.pm
+++ lib/Parser/Item.pm
@@ -6,6 +6,7 @@
 package Parser::Item;
 use strict;
 use UNIVERSAL;
+use Scalar::Util;
 
 #
 #  Make these available to Parser items
@@ -13,6 +14,8 @@
 sub isa {UNIVERSAL::isa(@_)}
 sub can {UNIVERSAL::can(@_)}
 
+sub weaken {Scalar::Util::weaken((shift)->{equation})}
+
 #
 #  Return the class name of an item
 #
@@ -135,9 +138,10 @@
   my $self = shift; my $equation = shift;
   my $new = {%{$self}};
   if (ref($self) ne 'HASH') {
-    bless $new, ref($self);
     $new->{equation} = $equation if defined($equation);
     $new->{ref} = undef;
+    bless $new, ref($self);
+    $new->weaken;
   }
   $new->{type} = copy($self->{type}) if defined($self->{type});
   return $new;
Index: UOP.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/UOP.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -Llib/Parser/UOP.pm -Llib/Parser/UOP.pm -u -r1.20 -r1.21
--- lib/Parser/UOP.pm
+++ lib/Parser/UOP.pm
@@ -17,6 +17,7 @@
     uop => $uop, op => $op,
     def => $def, ref => $ref, equation => $equation
   }, $def->{class};
+  $UOP->weaken;
   $UOP->{isConstant} = 1 if $op->{isConstant};
   $UOP->_check;
   $UOP = $UOP->Item("Value")->new($equation,[$UOP->eval])
Index: Formula.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Formula.pm,v
retrieving revision 1.58
retrieving revision 1.59
diff -Llib/Value/Formula.pm -Llib/Value/Formula.pm -u -r1.58 -r1.59
--- lib/Value/Formula.pm
+++ lib/Value/Formula.pm
@@ -75,13 +75,13 @@
     $formula->{context} = $r->{context};
     $r = $r->{tree}->copy($formula);
   } else {
-    $r = $self->new($r)->{tree};
+    $r = $self->new($r)->{tree}->copy($formula);
   }
   if (ref($l) eq $class || ref($l) eq $pkg) {
     $formula->{context} = $l->{context};
     $l = $l->{tree}->copy($formula);
   } else {
-    $l = $self->new($l)->{tree};
+    $l = $self->new($l)->{tree}->copy($formula);
   }
   $bop = 'U' if $bop eq '+' &&
     ($l->type =~ m/Interval|Set|Union/ || $r->type =~ m/Interval|Set|Union/);
Index: Data.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Context/Data.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -Llib/Value/Context/Data.pm -Llib/Value/Context/Data.pm -u -r1.11 -r1.12
--- lib/Value/Context/Data.pm
+++ lib/Value/Context/Data.pm
@@ -4,6 +4,7 @@
 #
 package Value::Context::Data;
 use strict;
+use Scalar::Util;
 
 sub new {
   my $self = shift; my $class = ref($self) || $self;
@@ -17,6 +18,7 @@
     namePattern => '',      # pattern for allowed names for new items
     name => '', Name => '', # lower- and upper-case names for the class of items
   }, $class;
+  $data->weaken;
   $data->init();
   $parent->{$data->{dataName}} = {};
   push @{$parent->{data}{objects}},"_$data->{dataName}";
@@ -55,6 +57,11 @@
 }
 
 #
+#  Make context pointer a weak pointer (avoids reference loops)
+#
+sub weaken {Scalar::Util::weaken((shift)->{context})}
+
+#
 #  Update the context patterns
 #
 sub update {(shift)->{context}->update}