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