Item13897: Converted tests up to RobustnessTests

- Still fighting with Foswiki::Meta<->Foswiki::Prefs::TopicRAM circular dependecy. This time Foswiki::Meta _preferences attribute is weak. Prefs backend object is stored in application heap (topic_preferences key) to have correct references count. Possibly broken PrefsTests. :( - Added attribute _id on Foswiki::Object to uniquely identify any object in the core. Might be used as a cache key later. - Object cloning now preserves debugging attributes of the original object by prepending them with additional double underscore prefix. Would make it possible to track down a cloned object history.
foswiki · Jun 22, 2016 · aa29949 · aa29949
1 parent 7d3ef0b
commit aa29949
Show file tree

Hide file tree

Showing 8 changed files with 107 additions and 145 deletions.
diff --git a/UnitTestContrib/test/unit/RESTTests.pm b/UnitTestContrib/test/unit/RESTTests.pm
diff --git a/UnitTestContrib/test/unit/RobustnessTests.pm b/UnitTestContrib/test/unit/RobustnessTests.pm
@@ -19,17 +19,6 @@ extends qw( FoswikiTestCase );
 
 my $slash = ( $^O eq 'MSWin32' ) ? '\\' : '/';
 
-has request => (
-    is => 'rw',
-    isa =>
-      Foswiki::Object::isaCLASS( 'request', 'Foswiki::Request', noUndef => 1 )
-);
-has response => (
-    is => 'rw',
-    isa =>
-      Foswiki::Object::isaCLASS( 'request', 'Foswiki::Response', noUndef => 1 )
-);
-
 sub BUILD {
     my $this  = shift;
     my $class = ref($this);
@@ -43,7 +32,7 @@ around set_up => sub {
     $orig->( $this, @_ );
     $this->__EnvReset->{$_} = 'C' foreach grep { /(?:^LANG$|^LC_)/ } keys %ENV;
     $Foswiki::cfg{Site}{Locale} = 'en_US.UTF-8';
-    $this->createNewFoswikiSession();
+    $this->createNewFoswikiApp;
     Foswiki::Sandbox::_assessPipeSupport();
 };
 
@@ -284,12 +273,13 @@ sub test_sanitizeAttachmentName_unicode {
     my $query;
 
     $Foswiki::cfg{Store}{Encoding} = 'utf-8';
-    require Unit::Request;
-    $query = Unit::Request->new( initializer => "" );
-    $query->path_info( "/" . $this->test_web . "/" . $this->test_topic );
-    $this->createNewFoswikiSession( undef, $query );
-    $this->request($query);
-    $this->response( Unit::Response->new );
+    $this->createNewFoswikiApp(
+        requestParams => { initializer => "", },
+        engineParams  => {
+            initialAttributes =>
+              { path_info => "/" . $this->test_web . "/" . $this->test_topic, },
+        },
+    );
     $this->test_topicObject(
         ( Foswiki::Func::readTopic( $this->test_web, $this->test_topic ) )[0] );
     $this->test_topicObject->text("BLEEGLE\n");

diff --git a/core/lib/Foswiki/Meta.pm b/core/lib/Foswiki/Meta.pm
@@ -210,9 +210,21 @@ has _indices => (
 );
 has _preferences => (
     is        => 'rw',
+    weak_ref  => 1,
     lazy      => 1,
     predicate => 1,
     clearer   => 1,
+    trigger   => sub {
+        my $this = shift;
+
+        # SMELL Experimental. To avoid circular dependency between a topic
+        # object and it's preferences object which points backs thru its
+        # topicObject attribute we shall weaken the _preferences attribute but
+        # instead store the _preferences object in some semi-permanent store.
+        # Shall be replaced with some universal caching framework later.
+        # See DEMOLISH for more.
+        $this->app->heap->{topic_preferences}{ $this->_id } = $_[0];
+    },
 );
 has _latestIsLoaded => (
     is      => 'rw',
@@ -484,11 +496,6 @@ sub BUILD {
     # Note: internal fields are prepended with _. All uppercase
     # fields will be assumed to be meta-data.
 
-    # Preferences cache object. We store a pointer, rather than looking
-    # up the name each time, because we want to be able to invalidate the
-    # loaded preferences if this object is loaded.
-    #$this->_clear_preferences;
-
     if ( $this->has_text && defined $this->text ) {
 
         # User supplied topic body forces us to consider this as the
@@ -629,6 +636,9 @@ which may have surprising effects on other code that shares the object.
 sub unload {
     my $this = shift;
 
+    # Delete preferences object loaded for this meta object.
+    delete $this->app->heap->{topic_preferences}{ $this->_id };
+
     # Avoid collisions, initiate removal from MetaCache only and only if object
     # has been previously stored in the cache.
     $this->app->search->metacache->removeMeta( $this->web, $this->topic )
@@ -637,10 +647,6 @@ sub unload {
     $this->_clear_latestIsLoaded;
     $this->clear_text;
 
-    # SMELL: _preferences object class must define DEMOLISH method and use to
-    # finalize the object.
-    $this->_clear_preferences;
-
     # Unload meta-data
     $this->clear_metaData;
     $this->_clear_indices;

diff --git a/core/lib/Foswiki/Object.pm b/core/lib/Foswiki/Object.pm
@@ -72,6 +72,18 @@ has __orig_file  => ( is => 'rw', clearer => 1, );
 has __orig_line  => ( is => 'rw', clearer => 1, );
 has __orig_stack => ( is => 'rw', clearer => 1, );
 
+has _id => (
+    is      => 'ro',
+    lazy    => 1,
+    clearer => 1,
+    default => sub {
+        my $this  = shift;
+        my $strID = ref($this) . '_' . refaddr($this);
+        $strID =~ s/:/_/g;
+        return $strID;
+    },
+);
+
 sub BUILDARGS {
     my ( $class, @params ) = @_;
 
@@ -259,13 +271,24 @@ sub _cloneData {
 
 # XXX Experimental.
 # clone works on low-level bypassing Moo's accessor methods.
+my @skip_attrs = qw(_id);
+
 sub clone {
     my $this = shift;
 
     $this->_clear__clone_heap;
     my @profile;
+    my $skipRx = '^(' . join( '|', @skip_attrs ) . ')$';
     foreach my $attr ( keys %$this ) {
-        next if $attr =~ /^__/;    # Skip debug-level attrs.
+        next if $attr =~ /$skipRx/;
+        my $destAttr = $attr;
+        if ( $destAttr =~ /^__/ ) {
+
+            # Debug attributes would be preserved but those coming from the
+            # source object would be kinda pushed on a stack by adding extra __
+            # prefix. This way we could trace an object history.
+            $destAttr = "__$destAttr";
+        }
         my $clone_method = "_clone_" . $attr;
         my $attrVal;
         if ( my $method = $this->can($clone_method) ) {
@@ -275,7 +298,7 @@ sub clone {
             $attrVal = $this->_cloneData( $this->{$attr}, $attr );
         }
 
-        push @profile, $attr, $attrVal;
+        push @profile, $destAttr, $attrVal;
     }
 
     my $newObj = ref($this)->new(@profile);

diff --git a/core/lib/Foswiki/Prefs/Stack.pm b/core/lib/Foswiki/Prefs/Stack.pm
@@ -66,29 +66,6 @@ has map => (
 
 =begin TML
 
----++ ObjectMethod finish()
-
-Break circular references.
-
-=cut
-
-# Note to developers; please undef *all* fields in the object explicitly,
-# whether they are references or not. That way this method is "golden
-# documentation" of the live fields in the object.
-#sub finish {
-#    my $this = shift;
-#    $this->clear_final;
-#    if ( $this->has_levels ) {
-#        foreach my $back ( @{ $this->levels } ) {
-#            $back->finish() if $back;
-#        }
-#    }
-#    $this->clear_levels;
-#    $this->clear_map;
-#}
-
-=begin TML
-
 ---++ ObjectMethod size() -> $size
 
 Returns the size of the stack in number of levels.

diff --git a/core/lib/Foswiki/Prefs/TopicRAM.pm b/core/lib/Foswiki/Prefs/TopicRAM.pm
@@ -43,8 +43,8 @@ has local => (
     isa     => Foswiki::Object::isaHASH( 'local', noUndef => 1 ),
 );
 has topicObject => (
-    is       => 'ro',
-    weak_ref => 1,
+    is      => 'ro',
+    clearer => 1,
     isa =>
       Foswiki::Object::isaCLASS( 'topicObject', 'Foswiki::Meta', noUndef => 1 ),
     required => 1,

diff --git a/core/lib/Foswiki/Response.pm b/core/lib/Foswiki/Response.pm
@@ -554,7 +554,9 @@ sub as_array {
         push @{ $rc[1] }, $hdr => $_ foreach @$val;
     }
 
-    $rc[2] = [ $this->body ];
+    # Never return undef body. Though let the attribute be undef to handle some
+    # special cases.
+    $rc[2] = [ $this->body // '' ];
 
     return \@rc;
 }

diff --git a/core/lib/Foswiki/UI/Rest.pm b/core/lib/Foswiki/UI/Rest.pm
@@ -278,9 +278,7 @@ sub rest {
     my $error = 0;
 
     try {
-        no strict 'refs';
-        $result = &$function( $app, $subject, $verb, $app->response );
-        use strict 'refs';
+        $result = $function->( $app, $subject, $verb, $app->response );
     }
     catch {
         my $e = $_;