Menu
▾
▴
[TWiki-Dev] [SVN] CrawfordCurrie r11019 - in twiki/branches/TWikiRelease04x00: lib test/unit
|
From: <de...@de...> - 2006-07-15 09:49:55
|
Author: CrawfordCurrie
Date: 2006-07-15 02:57:56 -0500 (Sat, 15 Jul 2006)
New Revision: 11019
Added:
twiki/branches/TWikiRelease04x00/test/unit/Fn_IF.pm
twiki/branches/TWikiRelease04x00/test/unit/Fn_NOP.pm
twiki/branches/TWikiRelease04x00/test/unit/Fn_SCRIPTURL.pm
twiki/branches/TWikiRelease04x00/test/unit/Fn_SECTION.pm
twiki/branches/TWikiRelease04x00/test/unit/Fn_SEP.pm
twiki/branches/TWikiRelease04x00/test/unit/Fn_USERINFO.pm
twiki/branches/TWikiRelease04x00/test/unit/TWikiFnTestCase.pm
Modified:
twiki/branches/TWikiRelease04x00/lib/TWiki.pm
twiki/branches/TWikiRelease04x00/test/unit/TWikiSuite.pm
twiki/branches/TWikiRelease04x00/test/unit/VariableTests.pm
Log:
Item2628: fixed USERINFO, added a testcase, and while I was there restructured the TWikiFn test cases to make it even easier to derive new ones, in another desperate, demoralising attempt to interest somebody, _anybody_, new in writing unit tests, because they are so useful, far more useful than new features IMHO.
Modified: twiki/branches/TWikiRelease04x00/lib/TWiki.pm
===================================================================
--- twiki/branches/TWikiRelease04x00/lib/TWiki.pm 2006-07-14 20:08:52 UTC (rev 11018)
+++ twiki/branches/TWikiRelease04x00/lib/TWiki.pm 2006-07-15 07:57:56 UTC (rev 11019)
@@ -3353,7 +3353,8 @@
my $user = $this->{user};
if( $params->{_DEFAULT} ) {
- $user = $this->{users}->findUser( $params->{_DEFAULT}, undef, 0 );
+ $user = $this->{users}->findUser( $params->{_DEFAULT}, undef, 1 );
+ return '' if !$user;
return '' if( $TWiki::cfg{AntiSpam}{HideUserDetails} &&
!$this->{user}->isAdmin() &&
$user != $this->{user} );
@@ -3363,25 +3364,25 @@
if ($info =~ /\$username/) {
my $username = $user->login();
- $info =~ s/\$username\b/$username/g;
+ $info =~ s/\$username/$username/g;
}
if ($info =~ /\$wikiname/) {
my $wikiname = $user->wikiName();
- $info =~ s/\$wikiname\b/$wikiname/g;
+ $info =~ s/\$wikiname/$wikiname/g;
}
if ($info =~ /\$wikiusername/) {
my $wikiusername = $user->webDotWikiName();
- $info =~ s/\$wikiusername\b/$wikiusername/g;
+ $info =~ s/\$wikiusername/$wikiusername/g;
}
if ($info =~ /\$emails/) {
my $emails = join(',', $user->emails());
- $info =~ s/\$emails\b/$emails/g;
+ $info =~ s/\$emails/$emails/g;
}
if ($info =~ /\$groups/) {
my @groupNames = map {$_->webDotWikiName();} $user->getGroups();
my $groups = join(', ', @groupNames);
$groups .= ' isAdmin()' if $user->isAdmin();
- $info =~ s/\$groups\b/$groups/g;
+ $info =~ s/\$groups/$groups/g;
}
#don't give out userlists to non-admins
Added: twiki/branches/TWikiRelease04x00/test/unit/Fn_IF.pm
===================================================================
--- twiki/branches/TWikiRelease04x00/test/unit/Fn_IF.pm 2006-07-14 20:08:52 UTC (rev 11018)
+++ twiki/branches/TWikiRelease04x00/test/unit/Fn_IF.pm 2006-07-15 07:57:56 UTC (rev 11019)
@@ -0,0 +1,61 @@
+use strict;
+
+# tests for the correct expansion of IF
+
+package IFTests;
+
+use base qw( TWikiFnTestCase );
+
+use TWiki;
+use Error qw( :try );
+
+sub new {
+ my $self = shift()->SUPER::new('IF', @_);
+ return $self;
+}
+
+sub test_correctIF {
+ my $this = shift;
+ $this->{twiki}->enterContext('test');
+ $TWiki::cfg{Fnargle} = 'Fleeble';
+ $TWiki::cfg{A}{B} = 'C';
+ my @tests = (
+ { test => 'A=B', then=>0, else=>1 },
+ { test => 'A!=B', then=>1, else=>0 },
+ { test => "A='A'", then=>1, else=>0 },
+ { test => "'A'=B", then=>0, else=>1 },
+ { test => 'context test', then=>1, else=>0 },
+ { test => '{Fnargle}=Fleeble', then=>1, else=>0 },
+ { test => '{A}{B}=C', then=>1, else=>0 },
+ { test => '$ WIKINAME = '.$this->{twiki}->{user}->wikiName(), then=>1, else=>0 },
+ { test => 'defined EDITBOXHEIGHT', then=>1, else=>0 },
+ { test => '0>1', then=>0, else=>1 },
+ { test => '1>0', then=>1, else=>0 },
+ { test => '1<0', then=>0, else=>1 },
+ { test => '0<1', then=>1, else=>0 },
+ { test => '0>=1', then=>0, else=>1 },
+ { test => '1>=0', then=>1, else=>0 },
+ { test => '1>=1', then=>1, else=>0 },
+ { test => '1<=0', then=>0, else=>1 },
+ { test => '0<=1', then=>1, else=>0 },
+ { test => '1<=1', then=>1, else=>0 },
+ { test => 'not A=B', then=>1, else=>0 },
+ { test => 'not not A=B', then=>0, else=>1 },
+ { test => 'A=A AND B=B', then=>1, else=>0 },
+ { test => 'A=A and B=B', then=>1, else=>0 },
+ { test => 'A=A and B=B', then=>1, else=>0 },
+ { test => 'A=B or B=B', then=>1, else=>0 },
+ { test => 'A=A or B=A', then=>1, else=>0 },
+ { test => 'A=B or B=A', then=>0, else=>1 },
+ { test => "\$PUBURLPATH='".$TWiki::cfg{PubUrlPath}."'", then=>1, else =>0 },
+ );
+
+ foreach my $test (@tests) {
+ my $text = '%IF{"'.$test->{test}.'" then="'.
+ $test->{then}.'" else="'.$test->{else}.'"}%';
+ my $result = $this->{twiki}->handleCommonTags($text, $this->{test_web}, $this->{test_topic});
+ $this->assert_equals('1', $result, $text." => ".$result);
+ }
+}
+
+1;
Added: twiki/branches/TWikiRelease04x00/test/unit/Fn_NOP.pm
===================================================================
--- twiki/branches/TWikiRelease04x00/test/unit/Fn_NOP.pm 2006-07-14 20:08:52 UTC (rev 11018)
+++ twiki/branches/TWikiRelease04x00/test/unit/Fn_NOP.pm 2006-07-15 07:57:56 UTC (rev 11019)
@@ -0,0 +1,50 @@
+use strict;
+
+# tests for the correct expansion of NOP
+
+package NOPTests;
+
+use base qw( TWikiFnTestCase );
+
+use TWiki;
+use Error qw( :try );
+
+sub new {
+ my $self = shift()->SUPER::new('NOP', @_);
+ return $self;
+}
+
+sub test_NOP {
+ my $this = shift;
+
+ my $result = $this->{twiki}->handleCommonTags("%NOP%", $this->{test_web}, $this->{test_topic});
+ $this->assert_equals('<nop>', $result);
+
+ $result = $this->{twiki}->handleCommonTags("%NOP{ ignore me }%", $this->{test_web}, $this->{test_topic});
+ $this->assert_equals(" ignore me ", $result);
+
+ $result = $this->{twiki}->handleCommonTags("%NOP{%SWINE%}%", $this->{test_web}, $this->{test_topic});
+ $this->assert_equals("%SWINE%", $result);
+
+ $result = $this->{twiki}->handleCommonTags("%NOP{%WEB%}%", $this->{test_web}, $this->{test_topic});
+ $this->assert_equals($this->{test_web}, $result);
+
+ $result = $this->{twiki}->handleCommonTags("%NOP{%WEB{}%}%", $this->{test_web}, $this->{test_topic});
+ $this->assert_equals($this->{test_web}, $result);
+
+ $result = $this->{twiki}->expandVariablesOnTopicCreation("%NOP%");
+ $this->assert_equals('', $result);
+
+ $result = $this->{twiki}->expandVariablesOnTopicCreation("%GM%NOP%TIME%");
+ $this->assert_equals('%GMTIME%', $result);
+
+ $result = $this->{twiki}->expandVariablesOnTopicCreation("%NOP{ ignore me }%");
+ $this->assert_equals('', $result);
+
+ # this *ought* to work, but by the definition of TML, it doesn't.
+ #$result = $this->{twiki}->handleCommonTags("%NOP{%FLEEB{}%}%", $this->{test_web}, $this->{test_topic});
+ #$this->assert_equals("%FLEEB{}%", $result);
+
+}
+
+1;
Added: twiki/branches/TWikiRelease04x00/test/unit/Fn_SCRIPTURL.pm
===================================================================
--- twiki/branches/TWikiRelease04x00/test/unit/Fn_SCRIPTURL.pm 2006-07-14 20:08:52 UTC (rev 11018)
+++ twiki/branches/TWikiRelease04x00/test/unit/Fn_SCRIPTURL.pm 2006-07-15 07:57:56 UTC (rev 11019)
@@ -0,0 +1,37 @@
+use strict;
+
+# tests for the correct expansion of SCRIPTURL
+
+package SCRIPTURLTests;
+
+use base qw( TWikiFnTestCase );
+
+use TWiki;
+use Error qw( :try );
+
+sub new {
+ my $self = shift()->SUPER::new('SCRIPTURL', @_);
+ return $self;
+}
+
+sub test_SCRIPTURL {
+ my $this = shift;
+
+ $TWiki::cfg{ScriptUrlPaths}{snarf} = "sausages";
+ undef $TWiki::cfg{ScriptUrlPaths}{view};
+ $TWiki::cfg{ScriptSuffix} = ".dot";
+
+ my $result = $this->{twiki}->handleCommonTags("%SCRIPTURL%", $this->{test_web}, $this->{test_topic});
+ $this->assert_str_equals(
+ "$TWiki::cfg{DefaultUrlHost}$TWiki::cfg{ScriptUrlPath}", $result);
+
+ $result = $this->{twiki}->handleCommonTags(
+ "%SCRIPTURLPATH{view}%", $this->{test_web}, $this->{test_topic});
+ $this->assert_str_equals("$TWiki::cfg{ScriptUrlPath}/view.dot", $result);
+
+ $result = $this->{twiki}->handleCommonTags(
+ "%SCRIPTURLPATH{snarf}%", $this->{test_web}, $this->{test_topic});
+ $this->assert_str_equals("sausages", $result);
+}
+
+1;
Added: twiki/branches/TWikiRelease04x00/test/unit/Fn_SECTION.pm
===================================================================
--- twiki/branches/TWikiRelease04x00/test/unit/Fn_SECTION.pm 2006-07-14 20:08:52 UTC (rev 11018)
+++ twiki/branches/TWikiRelease04x00/test/unit/Fn_SECTION.pm 2006-07-15 07:57:56 UTC (rev 11019)
@@ -0,0 +1,122 @@
+use strict;
+
+# tests for the correct expansion of SECTION
+
+package SECTIONTests;
+
+use base qw( TWikiFnTestCase );
+
+use TWiki;
+use Error qw( :try );
+
+sub new {
+ my $self = shift()->SUPER::new('SECTION', @_);
+ return $self;
+}
+
+sub dumpsec {
+ my $sec = shift;
+ return join(";", map { $_->stringify() } @$sec);
+}
+
+sub test_sections1 {
+ my $this = shift;
+
+ # Named section closed without being opened
+ my $text = '0%ENDSECTION{"name"}%1';
+ my( $nt, $s ) = TWiki::_parseSections( $text );
+ $this->assert_str_equals("01",$nt);
+ $this->assert_str_equals('',dumpsec($s));
+}
+
+sub test_sections2 {
+ my $this = shift;
+
+ # Named section opened but never closed
+ my $text = '0%STARTSECTION{"name"}%1';
+ my ( $nt, $s ) = TWiki::_parseSections( $text );
+ $this->assert_str_equals("01",$nt);
+ $this->assert_str_equals('end="2" name="name" start="1" type="section"',dumpsec($s));
+}
+
+sub test_sections3 {
+ my $this = shift;
+
+ # Unnamed section closed without being opened
+ my $text = '0%ENDSECTION%1';
+ my ( $nt, $s ) = TWiki::_parseSections( $text );
+ $this->assert_str_equals("01",$nt);
+ $this->assert_str_equals('',dumpsec($s));
+}
+
+sub test_sections4 {
+ my $this = shift;
+
+ # Unnamed section opened but never closed
+ my $text = '0%STARTSECTION%1';
+ my ( $nt, $s ) = TWiki::_parseSections( $text );
+ $this->assert_str_equals("01",$nt);
+ $this->assert_str_equals('end="2" name="_SECTION0" start="1" type="section"',dumpsec($s));
+}
+
+sub test_sections5 {
+ my $this = shift;
+
+ # Unnamed section closed by opening another section of the same type
+ my $text = '0%STARTSECTION%1%STARTSECTION%2';
+ my ( $nt, $s ) = TWiki::_parseSections( $text );
+ $this->assert_str_equals("012",$nt);
+ $this->assert_str_equals('end="2" name="_SECTION0" start="1" type="section";end="3" name="_SECTION1" start="2" type="section"',dumpsec($s));
+}
+
+sub test_sections6 {
+ my $this = shift;
+
+ # Named section overlaps unnamed section before it
+ my $text = '0%STARTSECTION%1%STARTSECTION{"named"}%2%ENDSECTION%3%ENDSECTION{"named"}%4';
+ my ( $nt, $s ) = TWiki::_parseSections( $text );
+ $this->assert_str_equals("01234",$nt);
+ $this->assert_str_equals('end="2" name="_SECTION0" start="1" type="section";end="4" name="named" start="2" type="section"',dumpsec($s));
+}
+
+sub test_sections7 {
+ my $this = shift;
+
+ # Named section overlaps unnamed section after it
+ my $text = '0%STARTSECTION{"named"}%1%STARTSECTION%2%ENDSECTION{"named"}%3%ENDSECTION%4';
+ my ( $nt, $s ) = TWiki::_parseSections( $text );
+ $this->assert_str_equals("01234",$nt);
+ $this->assert_str_equals('end="3" name="named" start="1" type="section";end="4" name="_SECTION0" start="2" type="section"',dumpsec($s));
+}
+
+sub test_sections8 {
+ my $this = shift;
+
+ # Unnamed sections of different types overlap
+ my $text = '0%STARTSECTION{type="include"}%1%STARTSECTION{type="templateonly"}%2%ENDSECTION{type="include"}%3%ENDSECTION{type="templateonly"}%4';
+ my ( $nt, $s ) = TWiki::_parseSections( $text );
+ $this->assert_str_equals("01234",$nt);
+ $this->assert_str_equals('end="3" name="_SECTION0" start="1" type="include";end="4" name="_SECTION1" start="2" type="templateonly"',dumpsec($s));
+}
+
+sub test_sections9 {
+ my $this = shift;
+
+ # Named sections of same type overlap
+ my $text = '0%STARTSECTION{"one"}%1%STARTSECTION{"two"}%2%ENDSECTION{"one"}%3%ENDSECTION{"two"}%4';
+ my ( $nt, $s ) = TWiki::_parseSections( $text );
+ $this->assert_str_equals("01234",$nt);
+ $this->assert_str_equals('end="3" name="one" start="1" type="section";end="4" name="two" start="2" type="section"',dumpsec($s));
+}
+
+sub test_sections10 {
+ my $this = shift;
+
+ # Named sections nested
+ my $text = '0%STARTSECTION{name="one"}%1%STARTSECTION{name="two"}%2%ENDSECTION{name="two"}%3%ENDSECTION{name="one"}%4';
+ my ( $nt, $s ) = TWiki::_parseSections( $text );
+ $this->assert_str_equals("01234",$nt);
+ $this->assert_str_equals('end="4" name="one" start="1" type="section";end="3" name="two" start="2" type="section"',dumpsec($s));
+}
+
+1;
Added: twiki/branches/TWikiRelease04x00/test/unit/Fn_SEP.pm
===================================================================
--- twiki/branches/TWikiRelease04x00/test/unit/Fn_SEP.pm 2006-07-14 20:08:52 UTC (rev 11018)
+++ twiki/branches/TWikiRelease04x00/test/unit/Fn_SEP.pm 2006-07-15 07:57:56 UTC (rev 11019)
@@ -0,0 +1,24 @@
+use strict;
+
+# tests for the correct expansion of SEP
+
+package SEPTests;
+
+use base qw( TWikiFnTestCase );
+
+use TWiki;
+use Error qw( :try );
+
+sub new {
+ my $self = shift()->SUPER::new('SEP', @_);
+ return $self;
+}
+
+sub test_SEP {
+ my $this = shift;
+ my $a = $this->{twiki}->handleCommonTags("%TMPL:P{sep}%", $this->{test_web}, $this->{test_topic});
+ my $b = $this->{twiki}->handleCommonTags("%SEP%", $this->{test_web}, $this->{test_topic});
+ $this->assert_str_equals($a,$b);
+}
+
+1;
Added: twiki/branches/TWikiRelease04x00/test/unit/Fn_USERINFO.pm
===================================================================
--- twiki/branches/TWikiRelease04x00/test/unit/Fn_USERINFO.pm 2006-07-14 20:08:52 UTC (rev 11018)
+++ twiki/branches/TWikiRelease04x00/test/unit/Fn_USERINFO.pm 2006-07-15 07:57:56 UTC (rev 11019)
@@ -0,0 +1,53 @@
+use strict;
+
+# tests for the correct expansion of USERINFO
+
+package USERINFOTests;
+
+use base qw( TWikiFnTestCase );
+
+use TWiki;
+use Error qw( :try );
+
+sub new {
+ my $self = shift()->SUPER::new('USERINFO', @_);
+ return $self;
+}
+
+sub set_up {
+ my $this = shift;
+ $this->SUPER::set_up(@_);
+ $this->{twiki}->{store}->saveTopic(
+ $this->{twiki}->{user}, $this->{users_web},
+ "GropeGroup",
+ " * Set GROUP = ScumBag,TWikiGuest\n");
+}
+
+sub test_basic {
+ my $this = shift;
+
+ $TWiki::cfg{AntiSpam}{HideUserDetails} = 0;
+ my $ui = $this->{twiki}->handleCommonTags('%USERINFO%', $this->{test_web}, $this->{test_topic});
+ $this->assert_str_equals(
+ "guest, $TWiki::cfg{UsersWebName}.TWikiGuest, ", $ui);
+}
+
+sub test_withUser {
+ my $this = shift;
+
+ $TWiki::cfg{AntiSpam}{HideUserDetails} = 0;
+ my $ui = $this->{twiki}->handleCommonTags('%USERINFO{"ScumBag"}%', $this->{test_web}, $this->{test_topic});
+ $this->assert_str_equals(
+ "scum, $TWiki::cfg{UsersWebName}.ScumBag, scumbag\@example.com", $ui);
+}
+
+sub test_formatted {
+ my $this = shift;
+
+ $TWiki::cfg{AntiSpam}{HideUserDetails} = 0;
+ my $ui = $this->{twiki}->handleCommonTags('%USERINFO{"ScumBag" format="W$wikiusernameU$wikinameE$emailsG$groupsE"}%', $this->{test_web}, $this->{test_topic});
+ $this->assert_str_equals(
+ "W$TWiki::cfg{UsersWebName}.ScumBagUScumBagEscumbag\@example.comG$TWiki::cfg{UsersWebName}.GropeGroupE", $ui);
+}
+
+1;
Added: twiki/branches/TWikiRelease04x00/test/unit/TWikiFnTestCase.pm
===================================================================
--- twiki/branches/TWikiRelease04x00/test/unit/TWikiFnTestCase.pm 2006-07-14 20:08:52 UTC (rev 11018)
+++ twiki/branches/TWikiRelease04x00/test/unit/TWikiFnTestCase.pm 2006-07-15 07:57:56 UTC (rev 11019)
@@ -0,0 +1,116 @@
+use strict;
+
+# Base class for tests for TWikiFns
+# This base class layers some extra protections on TWikiTestCase to try and make life
+# for TWikiFn testers even easier.
+# 1. Do not be afraid to modify TWiki::cfg. You cannot break other tests that way.
+# 2. Never, ever write to any webs except the {test_web} and {users_web}, or any other
+# test webs you create and remove (following the pattern shown below)
+# 3. The password manager is set to HtPasswdUser, and you can create users as shown
+# below in the creation of {test_user}
+# 4. A single user has been pre-registered, wikinamed 'ScumBag'
+
+package TWikiFnTestCase;
+
+use base qw( TWikiTestCase );
+
+use TWiki;
+use TWiki::UI::Register;
+use Error qw( :try );
+
+sub new {
+ my $class = shift;
+ my $var = shift;
+ my $this = $class->SUPER::new(@_);
+
+ $this->{var} = $var;
+ $this->{test_web} = 'Temporary'.$var.'TestWeb'.$var;
+ $this->{test_topic} = 'TestTopic'.$var;
+ $this->{users_web} = $TWiki::cfg{UsersWebName} = 'Temporary'.$var.'UsersWeb';
+ $this->{twiki} = undef;
+ $TWiki::cfg{MapUserToWikiName} = 1;
+ $TWiki::cfg{Htpasswd}{FileName} = '/tmp/junkpasswd'.$var;
+ $TWiki::cfg{PasswordManager} = 'TWiki::Users::HtPasswdUser';
+ $TWiki::cfg{Register}{NeedVerification} = 0;
+ $TWiki::cfg{MinPasswordLength} = 0;
+ return $this;
+}
+
+sub set_up {
+ my $this = shift;
+
+ $this->SUPER::set_up();
+
+ my $query = new CGI("");
+ $query->path_info("/$this->{test_web}/$this->{test_topic}");
+ $this->{twiki} = new TWiki(undef, $query);
+ $this->{twiki}->{store}->createWeb( $this->{twiki}->{user}, $this->{test_web} );
+ $this->{twiki}->{store}->createWeb( $this->{twiki}->{user}, $this->{users_web} );
+ $this->{test_user_forename} = 'Scum';
+ $this->{test_user_surname} = 'Bag';
+ $this->{test_user_wikiname} = $this->{test_user_forename}.$this->{test_user_surname};
+ $this->{test_user_login} = 'scum';
+ $this->{test_user_email} = 'sc...@ex...';
+ $this->registerUser($this->{test_user_login},
+ $this->{test_user_forename},
+ $this->{test_user_surname},
+ $this->{test_user_email});
+}
+
+sub tear_down {
+ my $this = shift;
+
+ $this->removeWebFixture( $this->{twiki}, $this->{test_web} );
+ $this->removeWebFixture( $this->{twiki}, $TWiki::cfg{UsersWebName} );
+ unlink($TWiki::cfg{Htpasswd}{FileName});
+
+ $this->SUPER::tear_down();
+
+}
+
+# callback used by Net.pm
+sub sentMail {
+ my($net, $mess ) = @_;
+ return undef;
+}
+
+# Used by subclasses to register test users
+sub registerUser {
+ my ($this, $loginname, $forename, $surname, $email) = @_;
+
+ my $query = new CGI ({
+ 'TopicName' => [ 'TWikiRegistration' ],
+ 'Twk1Email' => [ $email ],
+ 'Twk1WikiName' => [ "$forename$surname" ],
+ 'Twk1Name' => [ "$forename $surname" ],
+ 'Twk0Comment' => [ '' ],
+ 'Twk1LoginName' => [ $loginname ],
+ 'Twk1FirstName' => [ $forename ],
+ 'Twk1LastName' => [ $surname ],
+ 'action' => [ 'register' ]
+ });
+
+ $query->path_info( "/$this->{users_web}/TWikiRegistration" );
+ my $session = new TWiki( $TWiki::cfg{DefaultUserName}, $query);
+ $session->{net}->setMailHandler(\&sentMail);
+
+ try {
+ TWiki::UI::Register::register_cgi($session);
+ } catch TWiki::OopsException with {
+ my $e = shift;
+ $this->assert_str_equals("attention", $e->{template},$e->stringify());
+ $this->assert_str_equals("thanks", $e->{def},$e->stringify());
+ } catch TWiki::AccessControlException with {
+ my $e = shift;
+ $this->assert(0, $e->stringify);
+ } catch Error::Simple with {
+ $this->assert(0, shift->stringify());
+ } otherwise {
+ $this->assert(0, "expected an oops redirect");
+ };
+ # Reload caches
+ $this->{twiki} = new TWiki(undef, $this->{twiki}->{cgiQuery});
+
+}
+
+1;
Modified: twiki/branches/TWikiRelease04x00/test/unit/TWikiSuite.pm
===================================================================
--- twiki/branches/TWikiRelease04x00/test/unit/TWikiSuite.pm 2006-07-14 20:08:52 UTC (rev 11018)
+++ twiki/branches/TWikiRelease04x00/test/unit/TWikiSuite.pm 2006-07-15 07:57:56 UTC (rev 11019)
@@ -14,11 +14,14 @@
my @list;
opendir(DIR, ".") || die "Failed to open .";
foreach my $i (sort readdir(DIR)) {
+ if ($i =~ /^(Fn_[A-Z]+).pm$/) {
+ push(@list, $1);
+ }
next if $i =~ /^TWikiSuite/;
if( -e "$i/${i}Suite.pm" ) {
#push( @list, $i.'::'.$i );
- } elsif ( $i =~ s/(Suite).pm$/$1/ ) {
- push( @list, $i );
+ } elsif ( $i =~ /^(.*Suite).pm$/ ) {
+ push( @list, $1 );
}
}
closedir(DIR);
Modified: twiki/branches/TWikiRelease04x00/test/unit/VariableTests.pm
===================================================================
--- twiki/branches/TWikiRelease04x00/test/unit/VariableTests.pm 2006-07-14 20:08:52 UTC (rev 11018)
+++ twiki/branches/TWikiRelease04x00/test/unit/VariableTests.pm 2006-07-15 07:57:56 UTC (rev 11019)
@@ -1,8 +1,10 @@
use strict;
-# tests for the correct expansion of programmed TWiki variables
+# tests for the correct expansion of programmed TWiki variables (*not* TWikiFns, which
+# should have their own individual testcase)
-package RenderingTests;
+package GenericVariablesTests;
+
use base qw( TWikiTestCase );
use TWiki;
@@ -12,7 +14,7 @@
my $testWeb = 'TemporaryTestWeb';
my $testTopic = 'TestTopic';
-my $testUsersWeb = "TemporaryTesUsersUsersWeb";
+my $testUsersWeb = "TemporaryTestVariablesUsersWeb";
sub set_up {
my $this = shift;
@@ -42,66 +44,6 @@
return $self;
}
-sub test_SCRIPTURL {
- my $this = shift;
-
- $TWiki::cfg{ScriptUrlPaths}{snarf} = "sausages";
- undef $TWiki::cfg{ScriptUrlPaths}{view};
- $TWiki::cfg{ScriptSuffix} = ".dot";
-
- my $result = $twiki->handleCommonTags("%SCRIPTURL%", $testWeb, $testTopic);
- $this->assert_str_equals(
- "$TWiki::cfg{DefaultUrlHost}$TWiki::cfg{ScriptUrlPath}", $result);
-
- $result = $twiki->handleCommonTags(
- "%SCRIPTURLPATH{view}%", $testWeb, $testTopic);
- $this->assert_str_equals("$TWiki::cfg{ScriptUrlPath}/view.dot", $result);
-
- $result = $twiki->handleCommonTags(
- "%SCRIPTURLPATH{snarf}%", $testWeb, $testTopic);
- $this->assert_str_equals("sausages", $result);
-}
-
-sub test_NOP {
- my $this = shift;
-
- my $result = $twiki->handleCommonTags("%NOP%", $testWeb, $testTopic);
- $this->assert_equals('<nop>', $result);
-
- $result = $twiki->handleCommonTags("%NOP{ ignore me }%", $testWeb, $testTopic);
- $this->assert_equals(" ignore me ", $result);
-
- $result = $twiki->handleCommonTags("%NOP{%SWINE%}%", $testWeb, $testTopic);
- $this->assert_equals("%SWINE%", $result);
-
- $result = $twiki->handleCommonTags("%NOP{%WEB%}%", $testWeb, $testTopic);
- $this->assert_equals($testWeb, $result);
-
- $result = $twiki->handleCommonTags("%NOP{%WEB{}%}%", $testWeb, $testTopic);
- $this->assert_equals($testWeb, $result);
-
- $result = $twiki->expandVariablesOnTopicCreation("%NOP%");
- $this->assert_equals('', $result);
-
- $result = $twiki->expandVariablesOnTopicCreation("%GM%NOP%TIME%");
- $this->assert_equals('%GMTIME%', $result);
-
- $result = $twiki->expandVariablesOnTopicCreation("%NOP{ ignore me }%");
- $this->assert_equals('', $result);
-
- # this *ought* to work, but by the definition of TML, it doesn't.
- #$result = $twiki->handleCommonTags("%NOP{%FLEEB{}%}%", $testWeb, $testTopic);
- #$this->assert_equals("%FLEEB{}%", $result);
-
-}
-
-sub test_SEP {
- my $this = shift;
- my $a = $twiki->handleCommonTags("%TMPL:P{sep}%", $testWeb, $testTopic);
- my $b = $twiki->handleCommonTags("%SEP%", $testWeb, $testTopic);
- $this->assert_str_equals($a,$b);
-}
-
sub test_embeddedExpansions {
my $this = shift;
$twiki->{prefs}->pushPreferenceValues(
@@ -203,153 +145,5 @@
END
$this->assert_str_equals($xpect, $result);
}
-sub dumpsec {
- my $sec = shift;
- return join(";", map { $_->stringify() } @$sec);
-}
-sub test_sections1 {
- my $this = shift;
-
- # Named section closed without being opened
- my $text = '0%ENDSECTION{"name"}%1';
- my( $nt, $s ) = TWiki::_parseSections( $text );
- $this->assert_str_equals("01",$nt);
- $this->assert_str_equals('',dumpsec($s));
-}
-
-sub test_sections2 {
- my $this = shift;
-
- # Named section opened but never closed
- my $text = '0%STARTSECTION{"name"}%1';
- my ( $nt, $s ) = TWiki::_parseSections( $text );
- $this->assert_str_equals("01",$nt);
- $this->assert_str_equals('end="2" name="name" start="1" type="section"',dumpsec($s));
-}
-
-sub test_sections3 {
- my $this = shift;
-
- # Unnamed section closed without being opened
- my $text = '0%ENDSECTION%1';
- my ( $nt, $s ) = TWiki::_parseSections( $text );
- $this->assert_str_equals("01",$nt);
- $this->assert_str_equals('',dumpsec($s));
-}
-
-sub test_sections4 {
- my $this = shift;
-
- # Unnamed section opened but never closed
- my $text = '0%STARTSECTION%1';
- my ( $nt, $s ) = TWiki::_parseSections( $text );
- $this->assert_str_equals("01",$nt);
- $this->assert_str_equals('end="2" name="_SECTION0" start="1" type="section"',dumpsec($s));
-}
-
-sub test_sections5 {
- my $this = shift;
-
- # Unnamed section closed by opening another section of the same type
- my $text = '0%STARTSECTION%1%STARTSECTION%2';
- my ( $nt, $s ) = TWiki::_parseSections( $text );
- $this->assert_str_equals("012",$nt);
- $this->assert_str_equals('end="2" name="_SECTION0" start="1" type="section";end="3" name="_SECTION1" start="2" type="section"',dumpsec($s));
-}
-
-sub test_sections6 {
- my $this = shift;
-
- # Named section overlaps unnamed section before it
- my $text = '0%STARTSECTION%1%STARTSECTION{"named"}%2%ENDSECTION%3%ENDSECTION{"named"}%4';
- my ( $nt, $s ) = TWiki::_parseSections( $text );
- $this->assert_str_equals("01234",$nt);
- $this->assert_str_equals('end="2" name="_SECTION0" start="1" type="section";end="4" name="named" start="2" type="section"',dumpsec($s));
-}
-
-sub test_sections7 {
- my $this = shift;
-
- # Named section overlaps unnamed section after it
- my $text = '0%STARTSECTION{"named"}%1%STARTSECTION%2%ENDSECTION{"named"}%3%ENDSECTION%4';
- my ( $nt, $s ) = TWiki::_parseSections( $text );
- $this->assert_str_equals("01234",$nt);
- $this->assert_str_equals('end="3" name="named" start="1" type="section";end="4" name="_SECTION0" start="2" type="section"',dumpsec($s));
-}
-
-sub test_sections8 {
- my $this = shift;
-
- # Unnamed sections of different types overlap
- my $text = '0%STARTSECTION{type="include"}%1%STARTSECTION{type="templateonly"}%2%ENDSECTION{type="include"}%3%ENDSECTION{type="templateonly"}%4';
- my ( $nt, $s ) = TWiki::_parseSections( $text );
- $this->assert_str_equals("01234",$nt);
- $this->assert_str_equals('end="3" name="_SECTION0" start="1" type="include";end="4" name="_SECTION1" start="2" type="templateonly"',dumpsec($s));
-}
-
-sub test_sections9 {
- my $this = shift;
-
- # Named sections of same type overlap
- my $text = '0%STARTSECTION{"one"}%1%STARTSECTION{"two"}%2%ENDSECTION{"one"}%3%ENDSECTION{"two"}%4';
- my ( $nt, $s ) = TWiki::_parseSections( $text );
- $this->assert_str_equals("01234",$nt);
- $this->assert_str_equals('end="3" name="one" start="1" type="section";end="4" name="two" start="2" type="section"',dumpsec($s));
-}
-
-sub test_sections10 {
- my $this = shift;
-
- # Named sections nested
- my $text = '0%STARTSECTION{name="one"}%1%STARTSECTION{name="two"}%2%ENDSECTION{name="two"}%3%ENDSECTION{name="one"}%4';
- my ( $nt, $s ) = TWiki::_parseSections( $text );
- $this->assert_str_equals("01234",$nt);
- $this->assert_str_equals('end="4" name="one" start="1" type="section";end="3" name="two" start="2" type="section"',dumpsec($s));
-}
-
-sub test_correctIF {
- my $this = shift;
- $twiki->enterContext('test');
- $TWiki::cfg{Fnargle} = 'Fleeble';
- $TWiki::cfg{A}{B} = 'C';
- my @tests = (
- { test => 'A=B', then=>0, else=>1 },
- { test => 'A!=B', then=>1, else=>0 },
- { test => "A='A'", then=>1, else=>0 },
- { test => "'A'=B", then=>0, else=>1 },
- { test => 'context test', then=>1, else=>0 },
- { test => '{Fnargle}=Fleeble', then=>1, else=>0 },
- { test => '{A}{B}=C', then=>1, else=>0 },
- { test => '$ WIKINAME = '.$twiki->{user}->wikiName(), then=>1, else=>0 },
- { test => 'defined EDITBOXHEIGHT', then=>1, else=>0 },
- { test => '0>1', then=>0, else=>1 },
- { test => '1>0', then=>1, else=>0 },
- { test => '1<0', then=>0, else=>1 },
- { test => '0<1', then=>1, else=>0 },
- { test => '0>=1', then=>0, else=>1 },
- { test => '1>=0', then=>1, else=>0 },
- { test => '1>=1', then=>1, else=>0 },
- { test => '1<=0', then=>0, else=>1 },
- { test => '0<=1', then=>1, else=>0 },
- { test => '1<=1', then=>1, else=>0 },
- { test => 'not A=B', then=>1, else=>0 },
- { test => 'not not A=B', then=>0, else=>1 },
- { test => 'A=A AND B=B', then=>1, else=>0 },
- { test => 'A=A and B=B', then=>1, else=>0 },
- { test => 'A=A and B=B', then=>1, else=>0 },
- { test => 'A=B or B=B', then=>1, else=>0 },
- { test => 'A=A or B=A', then=>1, else=>0 },
- { test => 'A=B or B=A', then=>0, else=>1 },
- { test => "\$PUBURLPATH='".$TWiki::cfg{PubUrlPath}."'", then=>1, else =>0 },
- );
-
- foreach my $test (@tests) {
- my $text = '%IF{"'.$test->{test}.'" then="'.
- $test->{then}.'" else="'.$test->{else}.'"}%';
- my $result = $twiki->handleCommonTags($text, $testWeb, $testTopic);
- $this->assert_equals('1', $result, $text." => ".$result);
- }
-}
-
1;
|