Item14237: Merge commit '0dcf5d6b521a43b4cb5faac610c94a543e8cdb61' in…

…to Item14237 * commit '0dcf5d6b521a43b4cb5faac610c94a543e8cdb61': Item13897: Fixed a cloning bug Item13897: Added a bit of docs for the previous commit.
foswiki · Mar 18, 2017 · 704c0f0 · 704c0f0
2 parents 1c9a6f6 + 0dcf5d6
commit 704c0f0
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 12 deletions.
diff --git a/core/lib/Foswiki/Class.pm b/core/lib/Foswiki/Class.pm
@@ -112,6 +112,14 @@ reimplementing or extending only key method(s).
 
 See more in =Foswiki::Extension::Empty=.
 
+---++ Class attributes recording
+
+When =FOSWIKI_ASSERTS= environment variable is set to true =Foswiki::Class=
+records attributes declared with Moo's =has= directive. Subroutine
+=getClassAttributes()= can be used to retrieve a list of declared attributes for
+a specific class. Attributes of class' parent classes and all applied roles are
+included.
+
 =cut
 
 # Naming conventions for this module:

diff --git a/core/lib/Foswiki/Object.pm b/core/lib/Foswiki/Object.pm
@@ -139,8 +139,10 @@ around BUILDARGS => sub {
             }
         }
 
-# If $paramHash is undef at this point then either @params is a key/value pairs array or no @_newParameters array defined.
-# SMELL XXX Number of elements in @params has to be checked and an exception thrown if it's inappropriate.
+        # If $paramHash is undef at this point then either @params is a
+        # key/value pairs array or no @_newParameters array defined.
+        # SMELL XXX Number of elements in @params has to be checked and an
+        # exception thrown if it's inappropriate.
         unless ( defined $paramHash ) {
             Foswiki::Exception::Fatal->throw(
                 text => "Odd number of elements in $class parameters hash" )
@@ -160,14 +162,18 @@ sub BUILD {
     my ($args) = @_;
 
     if (DEBUG) {
-        my ( $pkg, $file, $line );
-        my $sFrame = 0;
-        do {
-            ( $pkg, $file, $line ) = caller( ++$sFrame );
-          } while (
-            $pkg =~ /^(Foswiki::Object|Moo::|Method::Generate::Constructor)/ );
+
+        #my ( $pkg, $file, $line );
+        #my $sFrame = 0;
+        #do {
+        #    ( $pkg, $file, $line ) = caller( ++$sFrame );
+        #  } while (
+        #    $pkg =~ /^(Foswiki::Object|Moo::|Method::Generate::Constructor)/ );
+
+        my $noStackTrace = $ENV{FOSWIKI_NOSTACKTRACE} // 1;
+
         $this->__orig;
-        $this->__orig_stack( Carp::longmess('') );
+        $this->__orig_stack( Carp::longmess('') ) unless $noStackTrace;
 
         # Copy non-attribute __orig_ keys from constructor's profile or they'd
         # be lost.
@@ -232,7 +238,16 @@ sub _cloneData {
             $heap->{cloning_ref}{$refAddr} = $attr;
             if ( my $class = blessed($val) ) {
                 if ( $val->can('clone') ) {
-                    $cloned = $val->clone;
+                    try {
+                        $val->__clone_heap($heap);
+                        $val->__clone_heap->{parent} = $this;
+                        $cloned = $val->clone;
+                    }
+                    finally {
+                      # No matter what happens inside clone – always clear the
+                      # heap.
+                        $val->_clear__clone_heap;
+                    };
                 }
                 elsif ( ref($val) eq 'Regexp' ) {
                     $cloned = $val;
@@ -391,7 +406,7 @@ by the following rules:
 sub clone {
     my $this = shift;
 
-    $this->_clear__clone_heap;
+    $this->_clear__clone_heap unless defined $this->__clone_heap->{parent};
     my @profile;
 
     #my $skipRx = '^(' . join( '|', @skip_attrs ) . ')$';
@@ -424,7 +439,7 @@ sub clone {
     # bless a profile hash?
     my $newObj = ref($this)->new(@profile);
 
-    $this->_clear__clone_heap;
+    $this->_clear__clone_heap unless defined $this->__clone_heap->{parent};
 
     return $newObj;
 }