This is an automated email from the git hooks/post-receive script.

abe pushed a commit to annotated tag 0.50
in repository libcgi-test-perl.

commit 34c7930e303e23470df3c492e1216537aa7fee0d
Author: Alex Tokarev <noh...@nohuhu.org>
Date:   Thu Sep 4 22:45:19 2014 -0700

    All tests pass in Windows and Unix-like systems
---
 lib/CGI/Test.pm | 14 ++++-----
 t/01_env.t      | 10 +++++++
 t/02_parsing.t  |  6 +++-
 t/03_get.t      |  4 +++
 t/04_post.t     | 83 +++++++++++++++++++----------------------------------
 t/lib/browse.pm | 88 ++++++++++++++++++++++++++++++++-------------------------
 t/pod.t         | 12 ++++++--
 7 files changed, 111 insertions(+), 106 deletions(-)

diff --git a/lib/CGI/Test.pm b/lib/CGI/Test.pm
index 378db7a..5c6bef9 100644
--- a/lib/CGI/Test.pm
+++ b/lib/CGI/Test.pm
@@ -319,8 +319,6 @@ sub _cgi_request
 
     substr($upath, 0, length $base_path) = '';
 
-#    logdbg 'info', "uri $uri -> script+path $upath";
-
     #
     # We have script + path_info in the $upath variable.  To determine where
     # the path_info starts, we have to walk through the components and
@@ -350,8 +348,6 @@ sub _cgi_request
     my $script_name = $base_path . join("/",        @script);        # Virtual
     my $path        = "/" . join("/",               @components);    # Virtual
 
-#    logdbg 'info', "script=$script, path=$path";
-
     return $error->new(RC_NOT_FOUND,    $this) unless -f $script;
     return $error->new(RC_UNAUTHORIZED, $this) unless -x $script;
 
@@ -367,7 +363,7 @@ sub _cgi_request
     
     if (defined $input) {
         # In Windows, we use temp files instead of pipes to avoid
-        # duplication errors
+        # stream duplication errors
         if ( WINDOWS ) {
             ($in_fh, $in_fname) =
                 mkstemp(File::Spec->catfile($this->tmp_dir, "cgi_in.XXXXXX"));
@@ -423,7 +419,7 @@ sub _cgi_request
     #
 
     if ($pid == 0) {
-        close PWRITE if defined $input;    # Writing side of the pipe
+        close PWRITE if defined $input && !WINDOWS; # Writing side of the pipe
         
         $this->_run_cgi(
             -script_file => $script,         # Real path
@@ -445,7 +441,7 @@ sub _cgi_request
 
     close $out_fh unless WINDOWS;
     
-    if (defined $input)
+    if (defined $input && !WINDOWS)
     {                                        # Send POST input data
         close PREAD;
         syswrite PWRITE, $input->data, $input->length;
@@ -599,7 +595,7 @@ sub _run_cgi
     # which are very request-specific:
     #
 
-    $ENV{REQUEST_METHOD}  = defined $in ? "POST" : "GET";
+    $ENV{REQUEST_METHOD}  = defined $input ? "POST" : "GET";
     $ENV{PATH_INFO}       = $path;
     $ENV{SCRIPT_NAME}     = $name;
     $ENV{SCRIPT_FILENAME} = $script;
@@ -664,7 +660,7 @@ sub _run_cgi
 
     if ( WINDOWS ) {
         my $cmd_line = $input ? "$basename < ${in_fname} > ${out_fname}"
-                     :          "$basename >${out_fname}"
+                     :          "$basename < NUL >${out_fname}"
                      ;
 
         exec $cmd_line;
diff --git a/t/01_env.t b/t/01_env.t
index 0e856f7..7b49cd0 100644
--- a/t/01_env.t
+++ b/t/01_env.t
@@ -1,9 +1,19 @@
+use Config;
 use Test::More tests => 16;
 
 use CGI::Test;
 
 use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ };
 
+#
+# This is a workaround for a nasty Fcntl loading problem: it seems that
+# certain custom Perl builds fail to allocate some kind of resources, or
+# just try to load wrong shared objects. This results in tests
+# failing miserably; considering that custom builds are very common
+# among CPAN testers, this could be considered a serious problem.
+#
+$ENV{PATH} = $Config{bin} . ':' . $ENV{PATH};
+
 my $SERVER = "some-server";
 my $PORT = 18;
 my $BASE = "http://${SERVER}:${PORT}/cgi-bin";;
diff --git a/t/02_parsing.t b/t/02_parsing.t
index 969a8a6..cc394fb 100644
--- a/t/02_parsing.t
+++ b/t/02_parsing.t
@@ -1,10 +1,14 @@
+use Config;
+use URI;
+
 use Test::More tests => 44;
 
 use CGI::Test;
-use URI;
 
 use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ };
 
+$ENV{PATH} = $Config{bin} . ':' . $ENV{PATH};
+
 my $BASE = "http://server:18/cgi-bin";;
 my $SCRIPT = WINDOWS ? "getform.bat" : "getform";
 
diff --git a/t/03_get.t b/t/03_get.t
index b95c903..ddd4a70 100644
--- a/t/03_get.t
+++ b/t/03_get.t
@@ -1,9 +1,13 @@
+use Config;
+
 use Test::More tests => 14;
 
 use CGI::Test;
 
 use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ };
 
+$ENV{PATH} = $Config{bin} . ':' . $ENV{PATH};
+
 my $BASE = "http://server:18/cgi-bin";;
 my $SCRIPT = WINDOWS ? "getform.bat" : "getform";
 
diff --git a/t/04_post.t b/t/04_post.t
index 02a19e2..c77f322 100644
--- a/t/04_post.t
+++ b/t/04_post.t
@@ -1,81 +1,56 @@
-#
-# $Id: post.t,v 1.2 2003/09/29 11:00:51 mshiltonj Exp $
-#
-#  Copyright (c) 2001, Raphael Manfredi
-#  
-#  You may redistribute only under the terms of the Artistic License,
-#  as specified in the README file that comes with the distribution.
-#
-# HISTORY
-# $Log: post.t,v $
-# Revision 1.2  2003/09/29 11:00:51  mshiltonj
-#     CGI::Test has changed ownership. The new owner is Steven Hilton
-#     <mshilt...@mshiltonj.com>.  Many thanks to Raphael Manfredi
-#     and Steve Fink.
-#
-#     CGI::Test is now hosted as a SourceForge project. It is located
-#     at <http://cgi-test.sourceforge.net>.
-#
-#     POD updated to reflect the above.
-#
-#     make() method on various objects has been deprecated, and has been
-#     replaced by more conventional (for me, at least) new() method.
-#     Support for make() may be removed in a later release.
-#
-#     Entire codebase reformatted using perltidy
-#     Go to <http://perltidy.sourceforge.net/> to see how neat it is.
-#
-#     Self-referential object variable name standardized to '$this'
-#     throughout code.
-#
-# Revision 1.1.1.1  2003/09/23 09:47:26  mshiltonj
-# Initial Import
-#
-# Revision 0.1  2001/03/31 10:54:04  ram
-# Baseline for first Alpha release.
-#
-# $EndLog$
-#
+use Config;
+
+use Test::More tests => 14;
 
 use CGI::Test;
 
-print "1..13\n";
+use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ };
+
+$ENV{PATH} = $Config{bin} . ':' . $ENV{PATH};
 
 my $BASE = "http://server:18/cgi-bin";;
+my $SCRIPT = WINDOWS ? 'getform.bat' : 'getform';
 
 my $ct = CGI::Test->new(
        -base_url       => $BASE,
        -cgi_dir        => "t/cgi",
 );
 
-ok 1, defined $ct;
+ok defined $ct, "Got CGI::Test object";
+isa_ok $ct, 'CGI::Test', 'isa';
+
+my $page = $ct->GET("$BASE/$SCRIPT?method=POST&enctype=M");
 
-my $page = $ct->GET("$BASE/getform?method=POST&enctype=M");
-ok 2, !$page->is_error;
+ok $page->is_ok, "Page 1 OK";
+ok !$page->is_error, "Page 1 error code " . $page->error_code;
 
 my $form = $page->forms->[0];
-ok 3, $form->method eq "POST";
+
+is $form->method, "POST", "Page 1 form method";
+
 my @submit = $form->submits_named("Send");
-ok 4, @submit == 1;
+
+is @submit, 1, "Page 1 number of Send submits";
 
 my $months = $form->widget_by_name("months");
 $months->select("Jan");
 
 my $send = $form->submit_by_name("Send");
 my $page2 = $send->press;
-ok 5, !$page2->is_error;
 
-ok 6, !$page2->is_error;
-ok 7, $page2->form_count == 1;
-my $form2 = $page2->forms->[0];
+ok !$page2->is_error, "Page 2 error code " . $page2->error_code;
+is $page2->form_count, 1, "Page 2 form count";
 
+my $form2 = $page2->forms->[0];
 @submit = $form2->submits_named("Send");
-ok 8, @submit == 1;
-ok 9, $form2->method eq "POST";
-ok 10, $form2->enctype =~ /^multipart/;
+
+is @submit, 1, "Page 2 number of Send submits";
+is $form2->method, 'POST', "Form 2 method";
+like $form2->enctype, qr/multipart/, "Form 2 encoding";
 
 my $months2 = $form2->widget_by_name("months");
-ok 11, $months2->is_selected("Jul");
-ok 12, $months2->is_selected("Jan");
-ok 13, !$months2->is_selected("Feb");
+
+ok $months2->is_selected("Jul"), "Form 2 Jul is selected";
+ok $months2->is_selected("Jan"), "Form 2 Jan is selected";
+ok !$months2->is_selected("Feb"), "Form 2 Feb is not selected";
 
diff --git a/t/lib/browse.pm b/t/lib/browse.pm
index ee3431d..dbfa7bf 100644
--- a/t/lib/browse.pm
+++ b/t/lib/browse.pm
@@ -1,15 +1,18 @@
 package browse;
 
+use Config;
+use Test::More;
+
 use CGI::Test;
 
-use Config;
+use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ };
 
 #
-# This is a fix for nasty Fcntl loading problem: it seems that
-# custom-built Perl fails to allocate some kind of resources, or
-# just tries to load wrong shared object. This results in tests
+# This is a workaround for a nasty Fcntl loading problem: it seems that
+# certain custom Perl builds fail to allocate some kind of resources, or
+# just try to load wrong shared objects. This results in tests
 # failing miserably; considering that custom builds are very common
-# among CPAN testers, it is a serious problem.
+# among CPAN testers, this could be considered a serious problem.
 #
 $ENV{PATH} = $Config{bin} . ':' . $ENV{PATH};
 
@@ -19,41 +22,47 @@ sub browse {
     my $method  = $params{method};
     my $enctype = $params{enctype};
 
-       print "1..27\n";
+    plan tests => 27;
 
        my $BASE = "http://server:18/cgi-bin";;
+    my $SCRIPT = WINDOWS ? 'getform.bat' : 'getform';
+    my $ACTION = WINDOWS ? 'dumpargs.bat' : 'dumpargs';
+
        my $ct = CGI::Test->new(
                -base_url       => $BASE,
                -cgi_dir        => "t/cgi",
        );
 
-       my $query = "action=/cgi-bin/dumpargs";
+       my $query = "action=/cgi-bin/$ACTION";
        $query .= "&method=$method" if defined $method;
        $query .= "&enctype=$enctype" if defined $enctype;
 
-       my $page = $ct->GET("$BASE/getform?$query");
+       my $page = $ct->GET("$BASE/$SCRIPT?$query");
        my $form = $page->forms->[0];
 
-       ok 1, $form->action eq "/cgi-bin/dumpargs";
+       is $form->action, "/cgi-bin/$ACTION", "Action: " . $form->action;
 
        my $submit = $form->submit_by_name("Send");
-       ok 2, defined $submit;
+
+       ok defined $submit, "Send submit defined";
 
        my $page2 = $submit->press;
-       ok 3, $page2->is_ok;
+
+       ok $page2->is_ok, "Page 2 OK";
 
        my $args = parse_args($page2->raw_content);
-       ok 4,  $args->{counter} == 1;
-       ok 5,  $args->{title} eq "Mr";
-       ok 6,  $args->{name} eq "";
-       ok 7,  $args->{skills} eq "listening";
-       ok 8,  $args->{new} eq "ON";
-       ok 9,  $args->{color} eq "white";
-       ok 10, $args->{note} eq "";
-       ok 11, $args->{months} eq "Jul";
-       ok 12, $args->{passwd} eq "";
-       ok 13, $args->{Send} eq "Send";
-       ok 14, $args->{portrait} eq "";
+
+       is  $args->{counter}, 1, "Page 2 counter";
+       is  $args->{title}, "Mr", "Page 2 title";
+       is  $args->{name}, "", "Page 2 name";
+       is  $args->{skills}, "listening", "Page 2 skills";
+       is  $args->{new}, "ON", "Page 2 new";
+       is  $args->{color}, "white", "Page 2 color";
+       is  $args->{note}, "", "Page 2 note";
+       is  $args->{months}, "Jul", "Page 2 months";
+       is  $args->{passwd}, "", "Page 2 passwd";
+       is  $args->{Send}, "Send", "Page 2 send";
+       is  $args->{portrait}, "", "Page 2 portrait";
 
        my $r = $form->radio_by_name("title");
        $r->check_tagged("Miss");
@@ -81,26 +90,27 @@ sub browse {
        $t = $form->input_by_name("note");
        $t->replace("this\nis\nsome\ntext");
 
-       $page2 = $submit->press;
-       my $args2 = parse_args($page2->raw_content);
-
-       ok 15, $args2->{counter} == 1;
-       ok 16, $args2->{title} eq "Miss";
-       ok 17, $args2->{name} eq "";
-       ok 18, $args2->{skills} eq "listening";
-       ok 19, !exists $args2->{new};                   # unchecked, not 
submitted
-       ok 20, $args2->{color} eq "red";
-       ok 21, $args2->{note} eq "this is some text";
-       ok 22, join(" ", sort split(' ', $args2->{months})) eq "Feb Jan";
-       ok 23, $args2->{passwd} eq "foobar";
-       ok 24, $args2->{Send} eq "Send";
-       ok 25, $args2->{portrait} eq "this is it, disappointed?";
+       my $page3 = $submit->press;
+       my $args3 = parse_args($page3->raw_content);
+
+       is $args3->{counter}, 1, "Page 3 counter";
+       is $args3->{title}, "Miss", "Page 3 title";
+       is $args3->{name}, "", "Page 3 name";
+       is $args3->{skills}, "listening", "Page 3 skills";
+       ok !exists $args3->{new}, "Page 3 new";     # unchecked, not submitted
+       is $args3->{color}, "red", "Page 3 color";
+       is $args3->{note}, "this is some text", "Page 3 note";
+       is join(" ", sort split(' ', $args3->{months})), "Feb Jan", "Page 3 
months";
+       is $args3->{passwd}, "foobar", "Page 3 passwd";
+       is $args3->{Send}, "Send", "Page 3 send";
+       is $args3->{portrait}, "this is it, disappointed?", "Page 3 portrait";
 
        # Ensure we tested what was requested
        $method = "GET" unless defined $method;
-       ok 26, $form->method eq $method;
-       ok 27, substr($form->enctype, 0, 5) eq
-               (defined $enctype ? "multi" : "appli");
+    my $enctype_qr = defined $enctype ? qr/multipart/ : qr/urlencoded/;
+
+       is $form->method, $method, "Form method";
+       like $form->enctype, $enctype_qr, "Form encoding";
 }
 
 # Rebuild parameter list from the output of dumpargs into a HASH
diff --git a/t/pod.t b/t/pod.t
index e5ac2c6..6abe690 100644
--- a/t/pod.t
+++ b/t/pod.t
@@ -1,6 +1,12 @@
 use Test::More;
 
-eval "use Test::Pod 1.00";
-plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+if ( $ENV{POD_TESTS} ) {
+    eval "use Test::Pod 1.00";
+    plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+
+    all_pod_files_ok();
+}
+else {
+    plan skip_all => 'POD tests are not enabled.';
+}
 
-all_pod_files_ok();

-- 
Alioth's /usr/local/bin/git-commit-notice on 
/srv/git.debian.org/git/pkg-perl/packages/libcgi-test-perl.git

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to