r70765 - in /branches/upstream/libsocialtext-wikitest-perl/current: ./ lib/Socialtext/ lib/Socialtext/WikiFixture/ lib/Socialtext/WikiObject/ t/

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Mon Mar 7 01:24:02 UTC 2011


Author: jawnsy-guest
Date: Mon Mar  7 01:23:54 2011
New Revision: 70765

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=70765
Log:
[svn-upgrade] new version libsocialtext-wikitest-perl (0.07)

Modified:
    branches/upstream/libsocialtext-wikitest-perl/current/Changes
    branches/upstream/libsocialtext-wikitest-perl/current/META.yml
    branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture.pm
    branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture/Null.pm
    branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture/Selenese.pm
    branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiObject/TestPlan.pm
    branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiTest.pm
    branches/upstream/libsocialtext-wikitest-perl/current/t/fixture-selenese.t
    branches/upstream/libsocialtext-wikitest-perl/current/t/fixture.t
    branches/upstream/libsocialtext-wikitest-perl/current/t/testplan.t

Modified: branches/upstream/libsocialtext-wikitest-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsocialtext-wikitest-perl/current/Changes?rev=70765&op=diff
==============================================================================
--- branches/upstream/libsocialtext-wikitest-perl/current/Changes (original)
+++ branches/upstream/libsocialtext-wikitest-perl/current/Changes Mon Mar  7 01:23:54 2011
@@ -1,3 +1,15 @@
+0.07 - Mon Dec  6 17:13:38 PST 2010
+ - added select_and_wait()
+ - moved the start_time variable into the base class
+ - moved the handle_command up into the base class
+ - escape backticks for option names, to allow crazy options
+ - Fix a bug to allow UTF8 characters in regexps - Thanks Takatoshi Kitano
+ - Add the 'include' command to the base fixture
+ - move non-selenium functions into the fixture base class
+ - add a 'set_default' method that is like ||=
+ - Allow handle_command to pass through more than 2 args.
+ - fix a test
+
 0.06 - Thu Jun 21 15:47:13 PDT 2007
  - Fix a bug that prevented testing whether a value was "0"
  - Handle multi-byte characters better - Thanks Takatoshi Kitano

Modified: branches/upstream/libsocialtext-wikitest-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsocialtext-wikitest-perl/current/META.yml?rev=70765&op=diff
==============================================================================
--- branches/upstream/libsocialtext-wikitest-perl/current/META.yml (original)
+++ branches/upstream/libsocialtext-wikitest-perl/current/META.yml Mon Mar  7 01:23:54 2011
@@ -1,15 +1,18 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         Socialtext-WikiTest
-version:      0.06
-version_from: lib/Socialtext/WikiTest.pm
-installdirs:  site
-requires:
+--- #YAML:1.0
+name:                Socialtext-WikiTest
+version:             0.07
+abstract:            ~
+license:             ~
+author:              
+    - Luke Closs <cpan at 5thplane.com>
+generated_by:        ExtUtils::MakeMaker version 6.44
+distribution_type:   module
+requires:     
     mocked:                        0
     Socialtext::Resting:           0
     Socialtext::Resting::Utils:    0.04
     Test::Exception:               0
     Test::More:                    0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3

Modified: branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture.pm?rev=70765&op=diff
==============================================================================
--- branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture.pm (original)
+++ branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture.pm Mon Mar  7 01:23:54 2011
@@ -2,6 +2,7 @@
 use strict;
 use warnings;
 use Test::WWW::Selenium;
+use Test::More;
 
 =head1 NAME
 
@@ -9,7 +10,7 @@
 
 =cut
 
-our $VERSION = '0.05';
+our $VERSION = '0.06';
 
 =head1 SYNOPSIS
 
@@ -39,6 +40,7 @@
     bless $self, $class;
 
     $self->init;
+    $self->setup_table_variables;
 
     return $self;
 }
@@ -49,7 +51,7 @@
 
 =cut
 
-sub init {}
+sub init { }
 
 =head2 run_test_table( $table_ref )
 
@@ -60,16 +62,35 @@
 
 sub run_test_table {
     my $self = shift;
-    my $table = shift;
-
-    for my $row (@$table) {
+    $self->{table} = shift;
+
+    while (my $row = $self->_next_row) {
         $row->[0] =~ s/^\s*//;
         next unless $row->[0];
         next if $row->[0] =~ /^\*?command\*?$/i; # header
+
+        _escape_options($row);
         $self->handle_command(@$row);
     }
 
     $self->end_hook;
+}
+
+sub _next_row {
+    my $self = shift;
+    return shift @{ $self->{table} };
+}
+
+sub _escape_options {
+    my $row = shift;
+
+    for my $cell (@$row) {
+        # Trim backticks
+        $cell =~ s/^`(.+)`$/$1/;
+
+        # un-escape backticks
+        $cell =~ s/^\\`(.+)\\`$/`$1`/;
+    }
 }
 
 =head2 end_hook()
@@ -83,11 +104,121 @@
 
 =head2 handle_command( @row )
 
-Run the command.  Subclasses will implement this.
-
-=cut
-
-sub handle_command { die 'Subclass must implement' }
+Run the command.  Subclasses can override this.
+
+=cut
+
+sub handle_command {
+    my $self = shift;
+    my $command = shift;
+    $command =~ s/-/_/g;
+    die "Bad command for the fixture: ($command)\n"
+        unless $self->can($command);
+
+    $self->$command( $self->_munge_options(@_) );
+}
+
+sub _munge_options {
+    my $self = shift;
+
+    my @opts;
+    for (@_) {
+        my $var = defined $_ ? $_ : '';
+        $var =~ s/%%(\w+)%%/exists $self->{$1} ? $self->{$1} : die "Undef var - '$1'"/eg;
+        $var =~ s/\\n/\n/g;
+        push @opts, $var;
+    }
+    return @opts;
+}
+
+=head2 setup_table_variables
+
+Called by init() during object creation.  Use it to set variables 
+usable by commands in the wiki test tables.
+
+=cut
+
+sub setup_table_variables {
+    my $self = shift;
+    $self->{start_time} = time;
+}
+
+=head2 quote_as_regex( $option )
+
+Will convert an option to a regex.  If qr// is around the option text,
+the regex will not be escaped.  Be careful with your regexes.
+
+=cut
+
+sub quote_as_regex {
+    my $self = shift;
+    my $var = shift || '';
+
+    Encode::_utf8_on($var) unless Encode::is_utf8($var);
+    if ($var =~ qr{^qr/(.+?)/([imosx]*)$}) {
+        my $mods = $2 || 's';
+        return eval "qr/$1/$mods";
+    }
+    return qr/\Q$var\E/;
+}
+
+=head2 include( $page_name )
+
+Include the wiki test table from $page_name into the current table.
+
+It's kind of like a subroutine call.
+
+=cut
+
+sub include {
+    my $self      = shift;
+    my $page_name = shift;
+
+    print "# Including wikitest commands from $page_name\n";
+    my $tp = $self->{testplan}->new_testplan($page_name);
+
+    unshift @{ $self->{table} }, @{ $tp->{table} };
+}
+
+=head2 set( $name, $value )
+
+Stores a variable for later use.
+
+=cut
+
+sub set {
+    my ($self, $name, $value, $default) = @_;
+    unless (defined $name and defined $value) {
+        diag "Both name and value must be defined for set!";
+        return;
+    }
+
+    # Don't set the value if the default flag was passed in
+    return if $default and defined $self->{$name};
+
+    $self->{$name} = $value;
+    diag "Set '$name' to '$value'";
+}
+
+=head2 set_default( $name, $value )
+
+Stores a variable for later use, but only if it is not already set.
+
+=cut
+
+sub set_default { shift->set(@_, 1) }
+
+=head2 comment( $comment )
+
+Prints $comment to test output.
+
+=cut
+
+sub comment {
+    my ($self, $comment) = @_;
+    diag '';
+    diag "comment: $comment";
+}
 
 =head1 AUTHOR
 

Modified: branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture/Null.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture/Null.pm?rev=70765&op=diff
==============================================================================
--- branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture/Null.pm (original)
+++ branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture/Null.pm Mon Mar  7 01:23:54 2011
@@ -23,8 +23,16 @@
 sub handle_command { 
     my $self = shift;
     my $command = shift;
-    print "Null: $command\n" unless $self->{silent};
+
+    if ($self->can($command)) {
+        $self->$command(@_);
+    }
+    else {
+        print "Null: $command\n" unless $self->{silent};
+    }
     $CALLS++;
+    $self->{calls}{$command}++;
+    push @{ $self->{args}{$command} }, \@_;
     die if $command eq 'die';
 }
 

Modified: branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture/Selenese.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture/Selenese.pm?rev=70765&op=diff
==============================================================================
--- branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture/Selenese.pm (original)
+++ branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiFixture/Selenese.pm Mon Mar  7 01:23:54 2011
@@ -4,6 +4,7 @@
 use base 'Socialtext::WikiFixture';
 use Encode;
 use Test::More;
+use Carp qw(croak);
 
 =head1 NAME
 
@@ -65,25 +66,43 @@
             host        => $self->{host},
             port        => $self->{port} || 4444,
             browser_url => $self->{browser_url},
-            browser     => $ENV{selenium_browser} || '*firefox',
+            browser     => $self->{browser}  || $ENV{selenium_browser} || '*firefox',
+            verbose     => $self->{verbose},
         );
         $self->{_started_selenium}++;
     }
     $self->{selenium_timeout} ||= 10000;
 
-    $self->setup_table_variables;
-}
-
-=head2 setup_table_variables
-
-Called by init() during object creation.  Use it to set variables 
-usable by commands in the wiki test tables.
-
-=cut
-
-sub setup_table_variables {
-    my $self = shift;
-    $self->{start_time} = time;
+    $self->remove_selenium_frame if $self->{maximize};
+}
+
+=head2
+
+This removes the selenium frame accross the top so you can see the whole window
+
+=cut
+sub remove_selenium_frame {
+    my $self = shift;
+    my $cnode = "document.body.childNodes[1].childNodes[1]";
+
+    my $sel = $self->{selenium};
+
+    $sel->open('about:blank');
+
+    $sel->get_eval("window.frames[0].resizeTo(screen.width,screen.height)");
+
+    $sel->{browser_start_command} ||= '';
+    if ($sel->{browser_start_command} =~ /^\*(?:chrome|firefox)$/) {
+        $sel->get_eval("$cnode.firstChild.setAttribute('style','display:none')");
+        $sel->get_eval("$cnode.childNodes[2].style.width = screen.width + 'px'");
+        $sel->get_eval("$cnode.childNodes[2].childNodes[1].style.width = screen.width + 'px'");
+    }
+    elsif ($sel->{browser_start_command} =~ /^\*ie/) {
+        my $iframe = 'document.getElementById("myiframe")';
+        $sel->get_eval("$iframe.contentWindow.moveTo(0,0)");
+        $sel->get_eval("$iframe.outerHeight = screen.availHeight");
+        $sel->get_eval("$iframe.outerWidth = screen.availWidth");
+    }
 }
 
 =head2 end_hook()
@@ -110,7 +129,7 @@
     my $self = shift;
     my $sel = $self->{selenium};
     my $command = $self->_munge_command(shift);
-    my ($opt1, $opt2) = $self->_munge_options(@_);
+    my ($opt1, $opt2, @other) = $self->_munge_options(@_);
 
     # Convenience method
     if ($command eq 'text_like' and !$opt2) {
@@ -127,9 +146,10 @@
         }
     }
 
+    Encode::_utf8_on($opt2) unless Encode::is_utf8($opt2);
     # Try to guess _ok methods
     $command .= '_ok' if { map { $_ => 1 } qw(open type) }->{$command};
-    $self->$command($opt1, $opt2);
+    $self->$command($opt1, $opt2, @other);
 }
 
 sub _munge_command {
@@ -152,36 +172,14 @@
     return $command;
 }
 
-sub _munge_options {
-    my $self = shift;
-
-    my @opts;
-    for (@_) {
-        my $var = defined $_ ? $_ : '';
-        $var =~ s/%%(\w+)%%/exists $self->{$1} ? $self->{$1} : 'undef' /eg;
-        $var =~ s/\\n/\n/g;
-        push @opts, $var;
-    }
-    return @opts;
-}
-
-
-=head2 quote_as_regex( $option )
-
-Will convert an option to a regex.  If qr// is around the option text,
-the regex will not be escaped.  Be careful with your regexes.
-
-=cut
-
-sub quote_as_regex {
-    my $self = shift;
-    my $var = shift || '';
-
-    Encode::_utf8_on($var) unless Encode::is_utf8($var);
-    if ($var =~ qr{^qr/(.+?)/$}) {
-        return qr/$1/s;
-    }
-    return qr/\Q$var\E/;
+sub _try_condition {
+    my ($self, $condition, $arg, $timeout) = @_;
+
+    $timeout = $self->{selenium_timeout} unless defined $timeout;
+    $arg =~ s/'/\\'/g;
+
+    my $cmd = "try { $condition('$arg') ? true : false } catch(e) { false }";
+    $self->{selenium}->wait_for_condition_ok($cmd, $timeout);
 }
 
 =head2 click_and_wait()
@@ -190,17 +188,28 @@
 
 =cut
 
-sub click_and_wait {
-    my ($self, $opt1, $opt2) = @_;
+sub click_and_wait { shift->_and_wait('click_ok', @_) }
+
+=head2 select_and_wait()
+
+Selects and waits.
+
+=cut
+
+sub select_and_wait { shift->_and_wait('select_ok', @_) }
+
+sub _and_wait {
+    my ($self, $method, $opt1, $opt2) = @_;
     my $sel = $self->{selenium};
 
     my @args;
     push @args, $opt2 if $opt2;
-    $sel->click_ok($opt1, @args);
-    $sel->wait_for_page_to_load_ok($self->{selenium_timeout}, @args);
+    $sel->$method($opt1, @args);
+    $sel->wait_for_page_to_load_ok($self->{selenium_timeout});
 }
 
 =head2 text_present_like()
+
 
 Search entire body for given text
 
@@ -211,32 +220,36 @@
     $self->{selenium}->text_like('//body', $opt1);
 }
 
-=head2 comment( $comment )
-
-Prints $comment to test output.
-
-=cut
-
-sub comment {
-    my ($self, $comment) = @_;
-    diag '';
-    diag "comment: $comment";
-}
-
-=head2 set( $name, $value )
-
-Stores a variable for later use.
-
-=cut
-
-sub set {
-    my ($self, $name, $value) = @_;
-    unless (defined $name and defined $value) {
-        diag "Both name and value must be defined for set!";
+=head2 store_value( $name, $locator )
+
+Stores an element's value as a variable for later use.
+
+=cut
+
+sub store_value {
+    my ($self, $name, $locator) = @_;
+    unless (defined $name and defined $locator) {
+        diag "Both name and locator must be defined for set!";
         return;
     }
-    $self->{$name} = $value;
-    diag "Set '$name' to '$value'";
+    $self->{$name} = $self->{selenium}->get_value($locator);
+    diag "Set '$name' to '$self->{$name}'";
+}
+
+=head2 store_text( $name, $locator )
+
+Stores an element's text as a variable for later use.
+
+=cut
+
+sub store_text {
+    my ($self, $name, $locator) = @_;
+    unless (defined $name and defined $locator) {
+        diag "Both name and locator must be defined for set!";
+        return;
+    }
+    $self->{$name} = $self->{selenium}->get_text($locator);
+    diag "Set '$name' to '$self->{$name}'";
 }
 
 =head2 print_page()
@@ -251,12 +264,90 @@
     print $self->get_text('//body');
 }
 
+=head2 pause($timeout)
+
+Waits $timeout milliseconds (default: 1 second)
+
+=cut
+
+sub pause {
+    my ($self,$timeout) = @_;
+    $timeout = 1000  unless defined $timeout;
+    $timeout /= 1000;
+    sleep $timeout;
+}
+
+=head2 wait_for_text_present_ok($text, $timeout)
+
+Waits until $text is present in the html source
+
+=cut
+
+sub wait_for_text_present_ok {
+    my $self = shift;
+    $self->_try_condition('selenium.isTextPresent', at _);
+}
+
+=head2 wait_for_element_present_ok($locator, $timeout)
+
+Waits until $locator is present
+
+=cut
+
+sub wait_for_element_present_ok {
+    my $self = shift;
+    $self->_try_condition('selenium.isElementPresent', at _);
+}
+
+=head2 wait_for_element_visible_ok($locator, $timeout)
+
+Waits until $locator is visible
+
+=cut
+
+sub wait_for_element_visible_ok {
+    my $self = shift;
+    $self->_try_condition('selenium.isVisible', at _);
+}
+
+=head2 wait_for_text_not_present_ok($text, $timeout)
+
+Waits until $text is not present in the html source
+
+=cut
+
+sub wait_for_text_not_present_ok {
+    my $self = shift;
+    $self->_try_condition('!selenium.isTextPresent', at _);
+}
+
+=head2 wait_for_element_not_present_ok($locator, $timeout)
+
+Waits until $locator is not present
+
+=cut
+
+sub wait_for_element_not_present_ok {
+    my $self = shift;
+    $self->_try_condition('!selenium.isElementPresent', at _);
+}
+
+=head2 wait_for_element_not_visible_ok($locator, $timeout)
+
+Waits until $locator is not visible
+
+=cut
+
+sub wait_for_element_not_visible_ok {
+    my $self = shift;
+    $self->_try_condition('!selenium.isVisible', at _);
+}
+
 =head2 AUTOLOAD
 
 Any functions not specified are passed to Test::WWW::Selenium
 
 =cut
-
 our $AUTOLOAD;
 sub AUTOLOAD {
     my $name = $AUTOLOAD;

Modified: branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiObject/TestPlan.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiObject/TestPlan.pm?rev=70765&op=diff
==============================================================================
--- branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiObject/TestPlan.pm (original)
+++ branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiObject/TestPlan.pm Mon Mar  7 01:23:54 2011
@@ -87,17 +87,63 @@
     }
 
     my $fixture_class = $self->_fixture || $self->{default_fixture};
-    return unless $self->{table} and $fixture_class;
 
-    unless ($fixture_class =~ /::/) {
-        $fixture_class = "Socialtext::WikiFixture::$fixture_class";
+    if ($self->{table} and $fixture_class) {
+        unless ($fixture_class =~ /::/) {
+            $fixture_class = "Socialtext::WikiFixture::$fixture_class";
+        }
+
+        eval "require $fixture_class";
+        die "Can't load fixture $fixture_class $@\n" if $@;
+
+        $self->_raise_permissions;
+
+        $self->{fixture_args}{testplan} ||= $self;
+        my $fix = $fixture_class->new( %{ $self->{fixture_args} } );
+        $self->{fixture} = $fix;
+        $fix->run_test_table($self->{table});
     }
 
-    eval "require $fixture_class";
-    die "Can't load fixture $fixture_class $@\n" if $@;
+    $self->_check_headers;
+}
 
-    my $fix = $fixture_class->new( %{ $self->{fixture_args} } );
-    $fix->run_test_table($self->{table});
+sub _check_headers {
+    my $self = shift;
+    my $heads = $self->{headings};
+    if ($heads and @$heads) {
+        my $head = $heads->[0];
+        if ($head =~ /^done_testing$/i) {
+            # nothing
+        }
+        elsif ($head =~ /^skip(?:: (.*))?/i) {
+            my $msg = $1 || "Skip!";
+            my $skipped = $self->{$head} || [ 1 ];
+            SKIP: {
+                skip($msg, scalar @$skipped);
+            }
+        }
+        elsif ($head =~ /^todo(?:: (.*))?/i) {
+            local $TODO = $1 || "Unamed";
+            Test::More::fail();
+        }
+        else {
+            die "Stopped at '$head'\n";
+        }
+    }
+}
+
+sub _raise_permissions {
+    my $self = shift;
+    my %browsers = (
+        '*firefox' => '*chrome',
+        '*iexplore' => '*iehta',
+    );
+    my $browser = $self->{fixture_args}{browser};
+    for (@{ $self->{items} || [] }) {
+        if (/^highpermissions$/i and $browsers{$browser}) {
+            $self->{fixture_args}{browser} = $browsers{$browser};
+        }
+    }
 }
 
 # Find the fixture in the page
@@ -117,15 +163,22 @@
         next unless $i =~ /^\[([^\]]+)\]/;
         my $page = $1;
         warn "# Loading test plan $page...\n";
-        my $plan = Socialtext::WikiObject::TestPlan->new(
-            page => $page,
-            rester => $self->{rester},
-            default_fixture => $self->{default_fixture},
-            fixture_args => $self->{fixture_args},
-        );
+        my $plan = $self->new_testplan($page);
         eval { $plan->run_tests };
         ok 0, "Error during test plan $page: $@" if $@;
     }
 }
 
+sub new_testplan {
+    my $self = shift;
+    my $page = shift;
+
+    return Socialtext::WikiObject::TestPlan->new(
+        page => $page,
+        rester => $self->{rester},
+        default_fixture => $self->{default_fixture},
+        fixture_args => $self->{fixture_args},
+    );
+}
+
 1;

Modified: branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiTest.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiTest.pm?rev=70765&op=diff
==============================================================================
--- branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiTest.pm (original)
+++ branches/upstream/libsocialtext-wikitest-perl/current/lib/Socialtext/WikiTest.pm Mon Mar  7 01:23:54 2011
@@ -8,7 +8,7 @@
 
 =cut
 
-our $VERSION = '0.06';
+our $VERSION = '0.07';
 
 =head1 AUTHOR
 

Modified: branches/upstream/libsocialtext-wikitest-perl/current/t/fixture-selenese.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsocialtext-wikitest-perl/current/t/fixture-selenese.t?rev=70765&op=diff
==============================================================================
--- branches/upstream/libsocialtext-wikitest-perl/current/t/fixture-selenese.t (original)
+++ branches/upstream/libsocialtext-wikitest-perl/current/t/fixture-selenese.t Mon Mar  7 01:23:54 2011
@@ -23,16 +23,19 @@
 | confirmation_like | pen? |
 | confirmation_like | qr/pen?/ |
 | clickAndWait | foo | |
+| selectAndWait | foo | bar |
 EOT
     tests => [
         [ open_ok => '/' ],
         [ title_like => qr/\Qmonkey\E/ ],
         [ text_like => ['//body', qr/\Qwater\E/] ],
         [ text_like => ['//body', qr/\Qpen?\E/] ],
-        [ text_like => ['//body', qr/pen?/] ],
+        [ text_like => ['//body', qr/pen?/s] ],
         [ confirmation_like => qr/\Qpen?\E/ ],
-        [ confirmation_like => qr/pen?/ ],
+        [ confirmation_like => qr/pen?/s ],
         [ click_ok => 'foo' ],
+        [ wait_for_page_to_load_ok => 10000 ],
+        [ select_ok => ['foo', 'bar'] ],
         [ wait_for_page_to_load_ok => 10000 ],
     ],
 );
@@ -62,10 +65,10 @@
 
 Variable_interpolation: {
     my $f = Socialtext::WikiFixture::Selenese->new(selenium => 'fake');
+    eval { $f->_munge_options('%%foo%%') };
+    like $@, qr/Undef var - 'foo'/;
+    $f->{foo} = 'bar';
     my @opts = $f->_munge_options('%%foo%%');
-    is_deeply \@opts, ['undef'];
-    $f->{foo} = 'bar';
-    @opts = $f->_munge_options('%%foo%%');
     is_deeply \@opts, ['bar'];
 }
 
@@ -117,36 +120,6 @@
     is $f->quote_as_regex('qr/foo/'), qr/foo/s;
 }
 
-Special_functions: {
-    no warnings qw/redefine once/;
-    my $f = Socialtext::WikiFixture::Selenese->new(selenium => 'fake');
-    my $diag = '';
-    *Socialtext::WikiFixture::Selenese::diag = sub { $diag .= "$_[0]\n" };
-
-    Comment: {
-        $f->comment('foo');
-        is $diag, "\ncomment: foo\n";
-    }
-
-    Set: {
-        $diag = '';
-        $f->set('foo', 'bar');
-        is $diag, "Set 'foo' to 'bar'\n";
-        is $f->{foo}, 'bar';
-    }
-
-    Bad_set: {
-        $diag = '';
-        $f->set('bar');
-        like $diag, qr/Both name and value/;
-        is $f->{bar}, undef;;
-
-        $diag = '';
-        $f->set(undef, 'bar');
-        like $diag, qr/Both name and value/;
-    }
-}
-
 sub sel_fixture_ok {
     my %args = @_;
 
@@ -155,3 +128,43 @@
         %args,
     );
 }
+
+Higher_permissions: {
+    my %browsers = (
+        '*firefox' => '*chrome',
+        '*iexplore' => '*iehta',
+    );
+    while (my ($low,$high) = each %browsers) {
+        for my $on (1, 0) {
+            my $rester = Socialtext::Resting::Mock->new;
+            my $text = join("",
+                "* Fixture: Selenese\n",
+                $on ? "* HighPermissions\n" : "",
+                "| open | / |\n",
+            );
+
+            $rester->put_page('Test Plan', $text);
+
+            my $plan = Socialtext::WikiObject::TestPlan->new(
+                rester => $rester,
+                page => 'Test Plan',
+                fixture_args => {
+                    browser => $low,
+                    host => 'selenium-server',
+                    username => 'testuser',
+                    password => 'password',
+                    browser_url => 'http://server',
+                    workspace => 'foo',
+                },
+            );
+
+            my $wanted = $on ? $high : $low,
+            my $not = $on ? '' : 'not ';
+
+            $plan->run_tests;
+            is  $plan->{fixture}{browser}, 
+                $wanted, 
+                "${not}HighPermissions causes = $wanted",
+        }
+    }
+}

Modified: branches/upstream/libsocialtext-wikitest-perl/current/t/fixture.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsocialtext-wikitest-perl/current/t/fixture.t?rev=70765&op=diff
==============================================================================
--- branches/upstream/libsocialtext-wikitest-perl/current/t/fixture.t (original)
+++ branches/upstream/libsocialtext-wikitest-perl/current/t/fixture.t Mon Mar  7 01:23:54 2011
@@ -3,8 +3,10 @@
 use warnings;
 use Test::More qw/no_plan/;
 use Socialtext::Resting::Mock;
+use Socialtext::WikiFixture::TestUtils qw/fixture_ok/;
 use lib 't/lib';
 use Test::WWW::Selenium qw/$SEL/; # mocked
+use Test::Exception;
 
 BEGIN {
     use lib 'lib';
@@ -24,6 +26,183 @@
     );
 
     eval { $plan->run_tests };
-    ok $@;
-}
-
+    like $@, qr/Bad command/;
+}
+
+Page_including: {
+    $rester->put_page('Foo', "| comment | included |\n");
+    $rester->put_page('Foo', "| comment | included |\n");
+    $rester->put_page('Foo', "| comment | included |\n");
+    $rester->put_page('Bar', "| include | Baz |\n");
+    $rester->put_page('Baz', "| comment | included2 |\n");
+    $rester->put_page('Test Plan', <<EOT);
+* Fixture: Null
+| include | Foo |
+| include | Foo |
+| include | Foo |
+| include | Bar |
+EOT
+    my $plan = Socialtext::WikiObject::TestPlan->new(
+        rester => $rester,
+        page => 'Test Plan',
+    );
+
+    $plan->run_tests;
+    is $plan->{fixture}{calls}{include}, 5;
+    is $plan->{fixture}{calls}{comment}, 4;
+}
+
+Special_functions: {
+    no warnings qw/redefine once/;
+    my $f = Socialtext::WikiFixture->new;
+    my $diag = '';
+    *Socialtext::WikiFixture::diag = sub { $diag .= "$_[0]\n" };
+
+    Comment: {
+        $f->comment('foo');
+        is $diag, "\ncomment: foo\n";
+    }
+
+    Set: {
+        $diag = '';
+        $f->set('foo', 'bar');
+        is $diag, "Set 'foo' to 'bar'\n";
+        is $f->{foo}, 'bar';
+    }
+
+    Using_a_variable: {
+        $diag = '';
+        $rester->put_page('Test Plan', <<'EOT');
+* Fixture: Socialtext::WikiFixture
+| set | mom | linda |
+| comment | Hi, %%mom%% |
+EOT
+        my $plan = Socialtext::WikiObject::TestPlan->new(
+            rester => $rester,
+            page => 'Test Plan',
+        );
+        $plan->run_tests;
+        like $diag, qr/comment: Hi, linda/;
+    }
+
+    Using_missing_variable: {
+        $rester->put_page('Test Plan', <<'EOT');
+* Fixture: Socialtext::WikiFixture
+| comment | Hi, %%mom%% |
+EOT
+        my $plan = Socialtext::WikiObject::TestPlan->new(
+            rester => $rester,
+            page => 'Test Plan',
+        );
+        eval { $plan->run_tests };
+        like $@, qr/Undef var - 'mom'/;
+    }
+
+    Set_default: {
+        $diag = '';
+        $f->set_default('poop', 'bar');
+        is $diag, "Set 'poop' to 'bar'\n";
+        is $f->{poop}, 'bar';
+
+        $diag = '';
+        $f->set_default('poop', 'baz');
+        is $diag, '';
+        is $f->{poop}, 'bar';
+
+        $diag = '';
+        $f->set('poop', 'baz');
+        is $diag, "Set 'poop' to 'baz'\n";
+        is $f->{poop}, 'baz';
+    }
+
+    Bad_set: {
+        $diag = '';
+        $f->set('bar');
+        like $diag, qr/Both name and value/;
+        is $f->{bar}, undef;;
+
+        $diag = '';
+        $f->set(undef, 'bar');
+        like $diag, qr/Both name and value/;
+    }
+}
+
+
+Escaping_options: {
+    my @testcases = (
+        [ '`foo`'   => 'foo' ],
+        [ '\`foo\`' => '`foo`' ],
+    );
+
+    for my $t (@testcases) {
+        $rester->put_page('Foo', <<EOT);
+* Fixture: Null
+| comment | $t->[0] |
+EOT
+        my $plan = Socialtext::WikiObject::TestPlan->new(
+            rester => $rester,
+            page => 'Foo',
+        );
+
+        $plan->run_tests;
+        is_deeply $plan->{fixture}{args}{comment}, [[$t->[1]]];
+        is $plan->{fixture}{calls}{comment}, 1;
+    }
+}
+
+Headers_die: {
+    $rester->put_page('Dier', <<EOT);
+* Fixture: Null
+| comment | pass here |
+^ Die here
+EOT
+    my $plan = Socialtext::WikiObject::TestPlan->new(
+        rester => $rester,
+        page => 'Dier',
+    );
+
+    dies_ok { $plan->run_tests } "Dies here";
+}
+
+Headers_done_testing: {
+    $rester->put_page('Liver', <<EOT);
+* Fixture: Null
+| comment | pass here |
+^ DONE_TESTING
+EOT
+    my $plan = Socialtext::WikiObject::TestPlan->new(
+        rester => $rester,
+        page => 'Liver',
+    );
+
+    lives_ok { $plan->run_tests } "Lives here";
+}
+
+Skip_all: {
+    $rester->put_page('Skipper', <<EOT);
+* Fixture: Null
+| comment | pass here |
+^ SKIP: until we've implemented this stuff
+| comment | skip me! |
+| comment | skip me too! |
+EOT
+    my $plan = Socialtext::WikiObject::TestPlan->new(
+        rester => $rester,
+        page => 'Skipper',
+    );
+    lives_ok { $plan->run_tests } "Skips";
+}
+
+TODO: {
+    $rester->put_page('todos', <<EOT);
+* Fixture: Null
+| comment | pass here |
+^ TODO: This is a todo
+^ TODO: This is another todo
+EOT
+    my $plan = Socialtext::WikiObject::TestPlan->new(
+        rester => $rester,
+        page => 'todos',
+    );
+    lives_ok { $plan->run_tests } "TODOs";
+}

Modified: branches/upstream/libsocialtext-wikitest-perl/current/t/testplan.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libsocialtext-wikitest-perl/current/t/testplan.t?rev=70765&op=diff
==============================================================================
--- branches/upstream/libsocialtext-wikitest-perl/current/t/testplan.t (original)
+++ branches/upstream/libsocialtext-wikitest-perl/current/t/testplan.t Mon Mar  7 01:23:54 2011
@@ -109,7 +109,7 @@
     
     if ($args{should_die}) {
         eval { $plan->run_tests };
-        ok $@;
+        ok $@, "Dies";
     }
     else {
         $plan->run_tests;




More information about the Pkg-perl-cvs-commits mailing list