diff _test/Test/Web/View.pm @ 188:029c9610528c

Memory leak tests in IMPL::Web::View
author cin
date Tue, 03 Apr 2012 20:08:42 +0400
parents 6c0fee769b0c
children 08015e2803f1
line wrap: on
line diff
--- a/_test/Test/Web/View.pm	Tue Apr 03 07:54:25 2012 +0400
+++ b/_test/Test/Web/View.pm	Tue Apr 03 20:08:42 2012 +0400
@@ -1,4 +1,5 @@
 package Test::Web::View;
+use IMPL::Profiler::Memory;
 use strict;
 use warnings;
 use utf8;
@@ -7,30 +8,50 @@
 __PACKAGE__->PassThroughArgs;
 
 use File::Slurp;
+use Scalar::Util qw(weaken);
 
-use IMPL::Test qw(assert test);
+use IMPL::Test qw(assert test GetCallerSourceLine);
 use IMPL::Web::View::TTLoader();
 
 use constant {
-	TTLoader => typeof IMPL::Web::View::TTLoader
+	TTLoader => typeof IMPL::Web::View::TTLoader,
+	MProfiler => 'IMPL::Profiler::Memory'
 };
 
+sub AssertMemoryLeak {
+	my $code = shift;
+	my $dump = shift;
+	
+	my $data = MProfiler->Monitor($code, sub { $_ =~ m/^IMPL::/} );
+	
+	assert( not($data->isLeak), "Memory leak detected", GetCallerSourceLine()  , @{$data->{objects}}, $dump ? $data->Dump : () );
+}
+
 sub templatesDir {
 	$_[0]->GetResourceDir('Resources','TTView');
 }
 
-test TTLoaderTests => sub {
+sub CreateLoader {
 	my ($this) = @_;
 	
 	my $loader = TTLoader->new(
 		{
 			INCLUDE_PATH => [
 				$this->templatesDir
-			]
+			],
+			INTERPOLATE => 1,
+			POST_CHOMP => 1,
+			ENCODING => 'utf-8'
 		},
 		ext => '.tt',
 		initializer => 'global.tt'
 	);
+}
+
+test TTLoaderTests => sub {
+	my ($this) = @_;
+	
+	my $loader = $this->CreateLoader();
 	
 	# test the loader to be able to find a desired resource
 	assert( defined($loader->template('simple') ) );
@@ -47,22 +68,16 @@
 	
 	# document should inherit loader's context 
 	assert( $doc->context->stash->get('user') eq 'test_user');
+	
+	# document should not have 'this' template variable
+	assert( not $doc->templateVars('this') );
+	
+	assert( $doc->context != $loader->context); # document should have an own context
 };
 
 test TTDocumentTests => sub {
 	my ($this) = @_;
-	my $loader = TTLoader->new(
-		{
-			INCLUDE_PATH => [
-				$this->templatesDir
-			],
-			INTERPOLATE => 1,
-			POST_CHOMP => 1,
-			ENCODING => 'utf-8'
-		},
-		ext => '.tt',
-		initializer => 'global.tt'
-	);
+	my $loader = $this->CreateLoader();
 	
 	my $doc = $loader->document('simple');
 	
@@ -70,10 +85,11 @@
 	
 	assert($doc->nodeName eq 'document');
 	assert(not $doc->can('notexists')); # autoloaded property should be ignored
-	assert($doc->notexists eq ''); # nonexisting property 
-	assert($doc->version == 10); # static metadata
-	assert($doc->user eq 'test_user'); # global data
-	assert($doc->templateVar eq 'initialized by the constructor'); # defined in CTOR block
+	assert(not defined $doc->notexists); # nonexisting property 
+	assert($doc->template->version == 10); # static metadata
+	assert($doc->templateVars('notexists') eq ''); #nonexisting template variable
+	assert($doc->templateVars('user') eq 'test_user'); # global data
+	assert($doc->templateVars('templateVar') eq 'initialized by the constructor'); # defined in CTOR block
 	
 	my $text = $doc->Render();
 	my $expected = read_file($this->GetResourceFile('Resources','TTView.Output','simple.txt'), binmode => ':utf8');
@@ -85,18 +101,7 @@
 test TTControlTests => sub {
 	my ($this) = @_;
 	
-	my $loader = TTLoader->new(
-		{
-			INCLUDE_PATH => [
-				$this->templatesDir
-			],
-			INTERPOLATE => 1,
-			POST_CHOMP => 1,
-			ENCODING => 'utf8'
-		},
-		ext => '.tt',
-		initializer => 'global.tt'
-	);
+	my $loader = $this->CreateLoader();
 	
 	my $doc = $loader->document('simple');
 	
@@ -106,22 +111,23 @@
 	
 	assert(defined $factory);
 	
+	assert(not $loader->context->stash->get('My.Org.Panel'));
+	
+	assert($factory->context->stash != $doc->context->stash);
+	
 	assert($factory == $doc->require('My/Org/Panel'), "Control should be loaded only once");
 	
 	my $ctl = $factory->new('information', { visualClass => 'simple' } );
 	
-	assert(defined $ctl);
-	
+	assert(defined $ctl);	
 	
 	assert($ctl->nodeName eq 'information', "Created control should have a name", "Got: ".$ctl->nodeName, "Expected: information");
 	
 	assert($ctl->nodeProperty('visualClass') eq 'simple');
 	
-	assert($ctl->controlObject == $ctl);
-	
 	assert($factory->instances == 1);
 	
-	assert($doc->context->stash->get('My.Org.Panel') == $factory);
+	assert($doc->templateVars('My.Org.Panel') == $factory);
 	
 	my $text = $ctl->Render();
 	my $expected = read_file($this->GetResourceFile('Resources', 'TTView.Output', 'Panel.txt'), binmode => ':utf8');
@@ -130,4 +136,27 @@
 	
 };
 
+test TestMemoryLeaks => sub {
+	my ($this) = @_;
+	
+	my $loader = $this->CreateLoader();
+	$loader->document('simple'); # force loader initialization
+	
+	AssertMemoryLeak(sub {		
+		my $doc = $loader->document('simple');
+	});
+		
+	AssertMemoryLeak(sub {
+		my $doc = $loader->document('simple');
+		$doc->Render( { self => $doc } );
+	});
+	
+	AssertMemoryLeak(sub{
+		my $doc = $loader->document('simple');
+		my $factory = $doc->require('My/Org/Panel');
+		#my $ctl = $doc->AppendChild($factory->new('information', { visualClass => 'complex' }) );		
+	});
+	
+};
+
 1;
\ No newline at end of file