[libcgi-test-perl] 14/24: First two test suites pass in Darwin and Windows
Axel Beckert
abe at deuxchevaux.org
Mon Jan 11 00:38:08 UTC 2016
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 01b0b2534f0810157ea201afde610c45e5926d2f
Author: Alex Tokarev <nohuhu at nohuhu.org>
Date: Thu Sep 4 20:42:17 2014 -0700
First two test suites pass in Darwin and Windows
---
MANIFEST | 2 +-
Makefile.PL | 12 ++---
lib/CGI/Test.pm | 2 +-
t/01_env.t | 8 +--
t/02_parsing.t | 120 ++++++++++++++++++++++++++---------------
t/05_play_get.t | 24 ++-------
t/06_play_post.t | 24 ++-------
t/07_play_multi.t | 24 ++-------
t/{browse.pl => lib/browse.pm} | 42 +--------------
9 files changed, 101 insertions(+), 157 deletions(-)
diff --git a/MANIFEST b/MANIFEST
index d965759..c5f89f4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -32,10 +32,10 @@ lib/CGI/Test/Page/Text.pm
Makefile.PL
MANIFEST
README
-t/browse.pl
t/cgi/dumpargs.in
t/cgi/getform.in
t/cgi/printenv.in
+t/lib/browse.pm
t/01_env.t
t/02_parsing.t
t/03_get.t
diff --git a/Makefile.PL b/Makefile.PL
index 1f88785..3d66807 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -12,7 +12,7 @@ use ExtUtils::MakeMaker;
use Config;
# /win/ won't work since it will also match Darwin (Mac OS X)
-my ($WINDOWS) = $^O =~ /Win32|cygwin/;
+use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ };
# Munge test CGI scripts so that they run under current Perl
my @cgi_files = do {
@@ -28,9 +28,7 @@ for my $file ( @cgi_files ) {
<$fin>;
};
- $text =~ s{#!PERL}{#!${^X}};
-
- if ( $WINDOWS ) {
+ if ( WINDOWS ) {
$file =~ s{\.in}{\.bat};
$file =~ s{/}{\\\\}g;
@@ -41,6 +39,8 @@ for my $file ( @cgi_files ) {
close $fout;
}
else {
+ $text =~ s{#!PERL}{#!${^X}};
+
$file =~ s{\.in}{};
open my $fout, '>', $file or die "Can't open $file for writing: $!";
@@ -51,11 +51,9 @@ for my $file ( @cgi_files ) {
};
};
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'CGI::Test',
- VERSION_FROM => 'lib/CGI/Test.pm', # finds $VERSION
+ VERSION_FROM => 'lib/CGI/Test.pm',
PREREQ_PM => {
'CGI' => '0',
'Digest::MD5' => '0',
diff --git a/lib/CGI/Test.pm b/lib/CGI/Test.pm
index 50e862f..378db7a 100644
--- a/lib/CGI/Test.pm
+++ b/lib/CGI/Test.pm
@@ -24,7 +24,7 @@ use vars qw($VERSION);
$VERSION = '0.50';
-use constant WINDOWS => eval { $^O =~ /win/i };
+use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ };
#############################################################################
#
diff --git a/t/01_env.t b/t/01_env.t
index 1293731..0e856f7 100644
--- a/t/01_env.t
+++ b/t/01_env.t
@@ -2,11 +2,13 @@ use Test::More tests => 16;
use CGI::Test;
+use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ };
+
my $SERVER = "some-server";
my $PORT = 18;
my $BASE = "http://${SERVER}:${PORT}/cgi-bin";
-my $SCRIPT = $^O =~ /win/i ? 'printenv.bat' : 'printenv';
-my $SCRIPT_FNAME = $^O =~ /win/i ? "t\\cgi\\$SCRIPT" : "t/cgi/$SCRIPT";
+my $SCRIPT = WINDOWS ? 'printenv.bat' : 'printenv';
+my $SCRIPT_FNAME = WINDOWS ? "t\\cgi\\$SCRIPT" : "t/cgi/$SCRIPT";
my $ct = CGI::Test->new(
-base_url => $BASE,
@@ -23,7 +25,7 @@ my $USER = "ram";
my $page = $ct->GET("$BASE/$SCRIPT/${PATH_INFO}?${QUERY}", $USER);
my $raw_length = length $page->raw_content;
-ok !$page->is_error, "No errors in page";
+ok !$page->is_error, "No errors in page " . $page->error_code;
ok $raw_length, "Got raw length: $raw_length";
my %V;
diff --git a/t/02_parsing.t b/t/02_parsing.t
index e9d3f8d..969a8a6 100644
--- a/t/02_parsing.t
+++ b/t/02_parsing.t
@@ -1,85 +1,117 @@
-use Test::More tests => 40;
+use Test::More tests => 44;
use CGI::Test;
+use URI;
+
+use constant WINDOWS => eval { $^O =~ /Win32|cygwin/ };
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");
+my $raw_length = length $page->raw_content;
+
+ok $page->is_ok, "Page OK";
+ok !$page->is_error, "No errors in page " . $page->error_code;
-my $page = $ct->GET("$BASE/getform");
-ok 2, $page->is_ok;
-ok 3, length $page->raw_content;
-ok 4, $page->content_type =~ m|^text/html\b|;
+ok $raw_length, "Got raw content length: $raw_length";
+like $page->content_type, qr|^text/html\b|, "Page content type matches";
my $forms = $page->forms;
-ok 5, @$forms == 1;
+
+cmp_ok @$forms, '==', 1, "Number of forms";
my $form = $forms->[0];
-my @names;
my $rg = $form->radio_groups;
-ok 6, ref $rg && (@names = $rg->names) && 1; # ok(x, 1, undef)
-ok 7, @names == 1;
+my @names = $rg->names;
+
+ok $rg, "Radio groups defined";
+is @names, 1, "Number of radio groups";
my $r_groupname = $names[0];
-ok 8, $rg->is_groupname($r_groupname);
+
+ok $rg->is_groupname($r_groupname), "Got radio group name: $r_groupname";
+
my @buttons = $rg->widgets_in($r_groupname);
-ok 9, @buttons == 3;
+
+is @buttons, 3, "Number of buttons in radio group";
+is $rg->widget_count($r_groupname), 3, "Number of widgets in radio group";
my $cg = $form->checkbox_groups;
-ok 10, ref $cg && (@names = $cg->names) && 1;
-ok 11, @names == 2;
+ at names = $cg->names;
+
+ok $cg, "Checkbox groups defined";
+is @names, 2, "Number of checkbox groups";
my $c_groupname = "skills";
-ok 12, $cg->is_groupname($c_groupname);
+
+ok $cg->is_groupname($c_groupname), "Got checkbox group name: $c_groupname";
+
@buttons = $cg->widgets_in($c_groupname);
-ok 13, @buttons == 4 && $cg->widget_count($c_groupname) == 4;
-ok 14, @{$form->inputs} == 4; # 1 of each (field, area, passwd, file)
-ok 15, @{$form->buttons} == 4;
-ok 16, @{$form->menus} == 2;
-ok 17, @{$form->checkboxes} == 5;
+is @buttons, 4, "Number of buttons in cbox group";
+is $cg->widget_count($c_groupname), 4, "Number of widgets in cbox group";
+
+# 1 of each: field, area, passwd, file
+my @wants = qw/ 4 4 2 5 /;
+for my $type ( qw/ inputs buttons menus checkboxes / ) {
+ my $want = shift @wants;
+ my $have = $form->$type;
+
+ is @$have, $want, "Number of $type in form";
+}
my $months = $form->menu_by_name("months");
-ok 18, defined $months;
-ok 19, !$months->is_popup;
-ok 20, $months->selected_count == 1;
-ok 21, @{$months->option_values} == 12;
-ok 22, $months->is_selected("Jul");
-ok 23, !$months->is_selected("Jan");
+
+ok defined $months, "Months menu defined";
+ok !$months->is_popup, "Months menu is not popup";
+is $months->selected_count, 1, "Months menu selected count";
+is @{$months->option_values}, 12, "Months menu option values";
+ok $months->is_selected("Jul"), "Months menu Jul is selected";
+ok !$months->is_selected("Jan"), "Months menu Jan is not selected";
my $color = $form->menu_by_name("color");
-ok 24, defined $color;
-ok 25, $color->is_popup;
-ok 26, $color->is_selected("white"); # implicit selection
-ok 27, $color->selected_count == 1;
-ok 28, $color->option_values->[0] eq "white";
-ok 29, !$color->is_selected("black");
+
+ok defined $color, "Color menu defined";
+ok $color->is_popup, "Color menu is popup";
+ok $color->is_selected("white"), "Color menu implicit selection";
+is $color->selected_count, 1, "Color menu selected count";
+is $color->option_values->[0], "white", "Color menu option value";
+ok !$color->is_selected("black"), "Color menu black is not selected";
my @menus = $form->widgets_matching(sub { $_[0]->is_menu });
-ok 30, @menus == 2;
+
+is @menus, 2, "Number of menus";
+
my @radio = $form->radios_named("title");
-ok 31, @radio == 3;
-require URI;
-ok 32, URI->new($form->action)->path eq "/cgi-bin/getform";
-ok 33, $form->method eq "GET";
-ok 34, $form->enctype eq "application/x-www-form-urlencoded";
+is @radio, 3, "Number of title radios";
+
+is( URI->new($form->action)->path, "/cgi-bin/$SCRIPT", "Script path" );
+is $form->method, "GET", "HTTP method";
+is $form->enctype, "application/x-www-form-urlencoded", "Encoding";
my @submit = grep { $_->name !~ /^\./ } $form->submit_list;
-ok 35, @submit == 2;
+
+is @submit, 2, "Number of submit buttons";
@buttons = $cg->widgets_in("no-such-group");
-ok 36, @buttons == 0;
-ok 37, 0 == $cg->widget_count("no-such-group");
+
+is @buttons, 0, "Number of buttons in no-such-group";
+is $cg->widget_count("no-such-group"), 0, "Number of widgets in no-such-group";
my $new = $form->checkbox_by_name("new");
-ok 38, defined $new;
-ok 39, $new->is_checked;
-ok 40, $new->is_standalone;
+
+ok defined $new, "New checkbox defined";
+ok $new->is_checked, "New checkbox is checked";
+ok $new->is_standalone, "New checkbox is standalone";
diff --git a/t/05_play_get.t b/t/05_play_get.t
index c3c37ba..0ee6d7d 100644
--- a/t/05_play_get.t
+++ b/t/05_play_get.t
@@ -1,22 +1,6 @@
-#
-# $Id: play_get.t,v 1.1.1.1 2003/09/23 09:47:26 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: play_get.t,v $
-# Revision 1.1.1.1 2003/09/23 09:47:26 mshiltonj
-# Initial Import
-#
-# Revision 0.1 2001/03/31 10:54:03 ram
-# Baseline for first Alpha release.
-#
-# $EndLog$
-#
+use lib 't/lib';
-require "t/browse.pl";
-browse(); # submits via GET
+use browse;
+
+browse::browse(); # submits via GET
diff --git a/t/06_play_post.t b/t/06_play_post.t
index 0884bd2..12f5e40 100644
--- a/t/06_play_post.t
+++ b/t/06_play_post.t
@@ -1,22 +1,6 @@
-#
-# $Id: play_post.t,v 1.1.1.1 2003/09/23 09:47:26 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: play_post.t,v $
-# 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 lib 't/lib';
-require "t/browse.pl";
-browse(-method => 'POST');
+use browse;
+
+browse::browse(-method => 'POST');
diff --git a/t/07_play_multi.t b/t/07_play_multi.t
index 71f2509..a4ce05b 100644
--- a/t/07_play_multi.t
+++ b/t/07_play_multi.t
@@ -1,22 +1,6 @@
-#
-# $Id: play_multi.t,v 1.1.1.1 2003/09/23 09:47:26 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: play_multi.t,v $
-# 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 lib 't/lib';
-require "t/browse.pl";
-browse(-method => 'POST', -enctype => "M");
+use browse;
+
+browse::browse(-method => 'POST', -enctype => "M");
diff --git a/t/browse.pl b/t/lib/browse.pm
similarity index 69%
rename from t/browse.pl
rename to t/lib/browse.pm
index 039c3c2..ee3431d 100644
--- a/t/browse.pl
+++ b/t/lib/browse.pm
@@ -1,44 +1,4 @@
-#
-# $Id: browse.pl,v 1.2 2003/09/29 11:00:50 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: browse.pl,v $
-# Revision 1.2 2003/09/29 11:00:50 mshiltonj
-# CGI::Test has changed ownership. The new owner is Steven Hilton
-# <mshiltonj at 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.1.1 2001/04/17 11:25:18 ram
-# patch3: changed test 22 to perform explicit sorting
-#
-# Revision 0.1 2001/03/31 10:54:03 ram
-# Baseline for first Alpha release.
-#
-# $EndLog$
-#
+package browse;
use CGI::Test;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcgi-test-perl.git
More information about the Pkg-perl-cvs-commits
mailing list