Add Checkbox form test
Completely rework output postprocessing to make it more flexible and added a test for duplicate test keys.
This commit is contained in:
Colin Kuskie
parent
833e5238eb
commit
29635395cf
14 changed files with 485 additions and 177 deletions
85
t/Form/Checkbox.t
Normal file
85
t/Form/Checkbox.t
Normal file
|
|
@ -0,0 +1,85 @@
|
|||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2006 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#-------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
use FindBin;
|
||||
use strict;
|
||||
use lib "$FindBin::Bin/../lib";
|
||||
|
||||
use WebGUI::Test;
|
||||
use WebGUI::Form;
|
||||
use WebGUI::Form::Checkbox;
|
||||
use WebGUI::Session;
|
||||
use HTML::Form;
|
||||
use WebGUI::Form_Checking;
|
||||
|
||||
#The goal of this test is to verify that Checkbox form elements work
|
||||
|
||||
use Test::More; # increment this value for each test you create
|
||||
|
||||
my $session = WebGUI::Test->session;
|
||||
|
||||
# put your tests here
|
||||
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'CHECK1',
|
||||
testValue => 'string1',
|
||||
expected => 'EQUAL',
|
||||
comment => 'string check'
|
||||
},
|
||||
{
|
||||
key => 'CHECK2',
|
||||
testValue => '002300',
|
||||
expected => 'EQUAL',
|
||||
comment => 'valid, leading zeroes'
|
||||
},
|
||||
];
|
||||
|
||||
my $formClass = 'WebGUI::Form::Checkbox';
|
||||
my $formType = 'Checkbox';
|
||||
|
||||
my $numTests = 6 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
plan tests => $numTests;
|
||||
|
||||
my ($header, $footer) = (WebGUI::Form::formHeader($session), WebGUI::Form::formFooter($session));
|
||||
|
||||
my $html = join "\n",
|
||||
$header,
|
||||
$formClass->new($session, {
|
||||
name => 'CBox1',
|
||||
value => 'Check me',
|
||||
checked => 1,
|
||||
})->toHtml,
|
||||
$footer;
|
||||
|
||||
my @forms = HTML::Form->parse($html, 'http://www.webgui.org');
|
||||
|
||||
##Test Form Generation
|
||||
|
||||
is(scalar @forms, 1, '1 form was parsed');
|
||||
|
||||
my @inputs = $forms[0]->inputs;
|
||||
is(scalar @inputs, 1, 'The form has 1 input');
|
||||
|
||||
#Basic tests
|
||||
|
||||
my $input = $inputs[0];
|
||||
is($input->name, 'CBox1', 'Checking input name');
|
||||
is($input->type, 'checkbox', 'Checking input type');
|
||||
is($input->value, 'Check me', 'Checking default value');
|
||||
is($input->disabled, undef, 'Disabled param not sent to form');
|
||||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, $testBlock);
|
||||
|
||||
|
|
@ -17,7 +17,6 @@ use WebGUI::Form;
|
|||
use WebGUI::Form::Email;
|
||||
use WebGUI::Session;
|
||||
use HTML::Form;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::Form_Checking;
|
||||
|
||||
#The goal of this test is to verify that Email form elements work.
|
||||
|
|
@ -29,19 +28,25 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
EMAIL1 => [ 'me@nowhere.com', 'EQUAL', 'regular email address'],
|
||||
EMAIL2 => [ "what do you want?", undef, 'not an email address'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'EMAIL1',
|
||||
testValue => 'me@nowhere.com',
|
||||
expected => 'EQUAL',
|
||||
comment => 'regular email address'
|
||||
},
|
||||
{
|
||||
key => 'EMAIL2',
|
||||
testValue => 'what do you want?',
|
||||
expected => undef,
|
||||
comment => 'not an email address'
|
||||
},
|
||||
];
|
||||
|
||||
my $formType = 'text';
|
||||
my $formClass = 'WebGUI::Form::Email';
|
||||
|
||||
my $numTests = 12 + scalar keys %testBlock;
|
||||
my $numTests = 12 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -96,4 +101,4 @@ is($input->{maxlength}, 200, 'Checking maxlength param, set');
|
|||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, 'email', %testBlock);
|
||||
WebGUI::Form_Checking::auto_check($session, 'email', $testBlock);
|
||||
|
|
|
|||
|
|
@ -18,7 +18,6 @@ use WebGUI::Form::Float;
|
|||
use WebGUI::Session;
|
||||
use Tie::IxHash;
|
||||
use HTML::Form;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::Form_Checking;
|
||||
|
||||
#The goal of this test is to verify that Float form elements work
|
||||
|
|
@ -29,26 +28,67 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
FLOAT1 => [ '-1.23456', 'EQUAL', 'valid, negative float'],
|
||||
FLOAT2 => [ '.23456', 'EQUAL', 'valid, no integer part'],
|
||||
FLOAT3 => [ '123456789.', 'EQUAL', 'valid, no fractional part'],
|
||||
FLOAT4 => [ '-.123456', 'EQUAL', 'valid, negative, no integer part'],
|
||||
FLOAT5 => [ '+123.456', 0, 'invalid, no explicit plus sign'],
|
||||
FLOAT6 => [ '123456', 'EQUAL', 'WRONG, no decimal point'],
|
||||
FLOAT7 => [ '......', 0, 'invalid, no digits'],
|
||||
FLOAT8 => [ '-00789.25', 'EQUAL', 'leading zeroes are okay'],
|
||||
FLOAT9 => [ '.123-456', 0, 'invalid, embedded minus sign'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'FLOAT1',
|
||||
testValue => '-1.23456',
|
||||
expected => 'EQUAL',
|
||||
comment => 'valid, negative float'
|
||||
},
|
||||
{
|
||||
key => 'FLOAT2',
|
||||
testValue => '.23456',
|
||||
expected => 'EQUAL',
|
||||
comment => 'valid, no integer part'
|
||||
},
|
||||
{
|
||||
key => 'FLOAT3',
|
||||
testValue => '123456789.',
|
||||
expected => 'EQUAL',
|
||||
comment => 'valid, no fractional part'
|
||||
},
|
||||
{
|
||||
key => 'FLOAT4',
|
||||
testValue => '-.123456',
|
||||
expected => 'EQUAL',
|
||||
comment => 'valid, negative, no integer part'
|
||||
},
|
||||
{
|
||||
key => 'FLOAT5',
|
||||
testValue => '+123.456',
|
||||
expected => '0',
|
||||
comment => 'invalid, no explicit plus sign'
|
||||
},
|
||||
{
|
||||
key => 'FLOAT6',
|
||||
testValue => '123456',
|
||||
expected => 'EQUAL',
|
||||
comment => 'WRONG, no decimal point'
|
||||
},
|
||||
{
|
||||
key => 'FLOAT7',
|
||||
testValue => '......',
|
||||
expected => 0,
|
||||
comment => 'invalid, no digits'
|
||||
},
|
||||
{
|
||||
key => 'FLOAT8',
|
||||
testValue => '-00789.25',
|
||||
expected => 'EQUAL',
|
||||
comment => 'leading zeroes are okay'
|
||||
},
|
||||
{
|
||||
key => 'FLOAT9',
|
||||
testValue => '.123-456',
|
||||
expected => 0,
|
||||
comment => 'invalid, embedded minus sign'
|
||||
},
|
||||
];
|
||||
|
||||
my $formClass = 'WebGUI::Form::Float';
|
||||
my $formType = 'Float';
|
||||
|
||||
my $numTests = 12 + scalar keys %testBlock;
|
||||
my $numTests = 12 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -103,5 +143,5 @@ is($input->{maxlength}, 20, 'set maxlength');
|
|||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, %testBlock);
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, $testBlock);
|
||||
|
||||
|
|
|
|||
|
|
@ -28,21 +28,42 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
HIDDEN1 => [ 'ABCDEzyxwv', 'EQUAL', 'alpha'],
|
||||
HIDDEN2 => [ '02468', 'EQUAL', 'numeric'],
|
||||
HIDDEN3 => [ 'NO WHERE', 'EQUAL', 'alpha space'],
|
||||
HIDDEN4 => [ '-.&*(', 'EQUAL', 'punctuation'],
|
||||
HIDDEN5 => [ " \t\n\tdata", 'EQUAL', 'white space'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'Hidden1',
|
||||
testValue => 'ABCDEzyxwv',
|
||||
expected => 'EQUAL',
|
||||
comment => 'alpha',
|
||||
},
|
||||
{
|
||||
key => 'Hidden2',
|
||||
testValue => '02468',
|
||||
expected => 'EQUAL',
|
||||
comment => 'numeric',
|
||||
},
|
||||
{
|
||||
key => 'Hidden3',
|
||||
testValue => 'NO WHERE',
|
||||
expected => 'EQUAL',
|
||||
comment => 'alpha space',
|
||||
},
|
||||
{
|
||||
key => 'Hidden4',
|
||||
testValue => '-.&*(',
|
||||
expected => 'EQUAL',
|
||||
comment => 'punctuation',
|
||||
},
|
||||
{
|
||||
key => 'Hidden5',
|
||||
testValue => ' \t\n\tdata',
|
||||
expected => 'EQUAL',
|
||||
comment => 'white space',
|
||||
},
|
||||
];
|
||||
|
||||
my $formClass = 'WebGUI::Form::Hidden';
|
||||
|
||||
my $numTests = 6 + scalar keys %testBlock;
|
||||
my $numTests = 6 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -79,4 +100,4 @@ is($input->disabled, undef, 'Disabled param not sent to form');
|
|||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, 'Hidden', %testBlock);
|
||||
WebGUI::Form_Checking::auto_check($session, 'Hidden', $testBlock);
|
||||
|
|
|
|||
|
|
@ -17,7 +17,6 @@ use WebGUI::Form;
|
|||
use WebGUI::Form::Integer;
|
||||
use WebGUI::Session;
|
||||
use HTML::Form;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::Form_Checking;
|
||||
|
||||
#The goal of this test is to verify that Integer form elements work
|
||||
|
|
@ -28,22 +27,43 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
INT1 => [ '-123456', 'EQUAL', 'valid, negative integer'],
|
||||
INT2 => [ '002300', 'EQUAL', 'valid, leading zeroes'],
|
||||
INT3 => [ '+123456', 0, 'reject explicitly positive integer'],
|
||||
INT4 => [ '123-456.', 0, 'rejects non-sense integer with negative sign'],
|
||||
INT5 => [ '123.456', 0, 'rejects float'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'Int1',
|
||||
testValue => '-123456',
|
||||
expected => 'EQUAL',
|
||||
comment => 'valid, negative integer',
|
||||
},
|
||||
{
|
||||
key => 'Int2',
|
||||
testValue => '002300',
|
||||
expected => 'EQUAL',
|
||||
comment => 'valid, leading zeroes',
|
||||
},
|
||||
{
|
||||
key => 'Int3',
|
||||
testValue => '+123456',
|
||||
expected => 0,
|
||||
comment => 'reject explicitly positive integer',
|
||||
},
|
||||
{
|
||||
key => 'Int4',
|
||||
testValue => '123-456.',
|
||||
expected => 0,
|
||||
comment => 'rejects non-sense integer with negative sign',
|
||||
},
|
||||
{
|
||||
key => 'Int5',
|
||||
testValue => '123.456',
|
||||
expected => 0,
|
||||
comment => 'rejects float',
|
||||
},
|
||||
];
|
||||
|
||||
my $formClass = 'WebGUI::Form::Integer';
|
||||
my $formType = 'Integer';
|
||||
|
||||
my $numTests = 12 + scalar keys %testBlock;
|
||||
my $numTests = 12 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -100,5 +120,5 @@ is($input->{maxlength}, 20, 'set maxlength');
|
|||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, %testBlock);
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, $testBlock);
|
||||
|
||||
|
|
|
|||
|
|
@ -17,7 +17,6 @@ use WebGUI::Form;
|
|||
use WebGUI::Form::Password;
|
||||
use WebGUI::Session;
|
||||
use HTML::Form;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::Form_Checking;
|
||||
|
||||
#The goal of this test is to verify that Password form elements work
|
||||
|
|
@ -28,19 +27,25 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
PASS1 => [ 'some user value', 'EQUAL', 'Regular text'],
|
||||
PASS2 => [ "some user value\nwith\r\nwhitespace", "EQUAL", 'Embedded whitespace is passed'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'Text1',
|
||||
testValue => 'some user value',
|
||||
expected => 'EQUAL',
|
||||
comment => 'Regular text',
|
||||
},
|
||||
{
|
||||
key => 'Text2',
|
||||
testValue => "some user value\nwith\r\nwhitespace",
|
||||
expected => "EQUAL",
|
||||
comment => 'Embedded whitespace is left',
|
||||
},
|
||||
];
|
||||
|
||||
my $formType = 'password';
|
||||
my $formClass = 'WebGUI::Form::Password';
|
||||
|
||||
my $numTests = 12 + scalar keys %testBlock;
|
||||
my $numTests = 12 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -99,4 +104,4 @@ is($input->{maxlength}, 200, 'Checking maxlength param, set');
|
|||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, %testBlock);
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, $testBlock);
|
||||
|
|
|
|||
|
|
@ -17,7 +17,6 @@ use WebGUI::Form;
|
|||
use WebGUI::Form::Phone;
|
||||
use WebGUI::Session;
|
||||
use HTML::Form;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::Form_Checking;
|
||||
|
||||
#The goal of this test is to verify that Phone form elements work
|
||||
|
|
@ -28,26 +27,67 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
PHONE1 => [ "503\n867\n5309", undef, 'newline separation'],
|
||||
PHONE2 => [ '503 867 5309', 'EQUAL', 'valid: space separation'],
|
||||
PHONE3 => [ '503.867.5309', 'EQUAL', 'valid: dot separation'],
|
||||
PHONE4 => [ '503 867 5309 x227', 'EQUAL', 'valid: extension syntax rejectd'],
|
||||
PHONE5 => [ '()()()', undef, 'invalid: no digits'],
|
||||
PHONE6 => [ '------', undef, 'invalid: no digits'],
|
||||
PHONE7 => [ "\n", undef, 'invalid: no digits'],
|
||||
PHONE8 => [ "++++", undef, 'invalid: no digits'],
|
||||
PHONE9 => [ "0xx31 3456 1234", 'EQUAL', 'Brazilian long distance'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'Phone1',
|
||||
testValue => '503\n867\n5309',
|
||||
expected => undef,
|
||||
comment => 'newline separation',
|
||||
},
|
||||
{
|
||||
key => 'Phone2',
|
||||
testValue => '503 867 5309',
|
||||
expected => 'EQUAL',
|
||||
comment => 'valid: space separation',
|
||||
},
|
||||
{
|
||||
key => 'Phone3',
|
||||
testValue => '503.867.5309',
|
||||
expected => 'EQUAL',
|
||||
comment => 'valid: dot separation',
|
||||
},
|
||||
{
|
||||
key => 'Phone4',
|
||||
testValue => '503 867 5309 x227',
|
||||
expected => 'EQUAL',
|
||||
comment => 'valid: extension syntax rejectd',
|
||||
},
|
||||
{
|
||||
key => 'Phone5',
|
||||
testValue => '()()()',
|
||||
expected => undef,
|
||||
comment => 'invalid: parens only, no digits',
|
||||
},
|
||||
{
|
||||
key => 'Phone6',
|
||||
testValue => '------',
|
||||
expected => undef,
|
||||
comment => 'invalid: dashes only, no digits',
|
||||
},
|
||||
{
|
||||
key => 'Phone7',
|
||||
testValue => "\n",
|
||||
expected => undef,
|
||||
comment => 'invalid: newline only, no digits',
|
||||
},
|
||||
{
|
||||
key => 'Phone8',
|
||||
testValue => '++++',
|
||||
expected => undef,
|
||||
comment => 'invalid, plusses only, no digits',
|
||||
},
|
||||
{
|
||||
key => 'Phone9',
|
||||
testValue => '0xx31 3456 1234',
|
||||
expected => 'EQUAL',
|
||||
comment => 'Brazilian long distance',
|
||||
},
|
||||
];
|
||||
|
||||
my $formClass = 'WebGUI::Form::Phone';
|
||||
my $formType = 'Phone';
|
||||
|
||||
my $numTests = 12 + scalar keys %testBlock;
|
||||
my $numTests = 12 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -104,5 +144,5 @@ is($input->{maxlength}, 20, 'set maxlength');
|
|||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, %testBlock);
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, $testBlock);
|
||||
|
||||
|
|
|
|||
|
|
@ -17,7 +17,6 @@ use WebGUI::Form;
|
|||
use WebGUI::Form::SelectBox;
|
||||
use WebGUI::Session;
|
||||
use HTML::Form;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::Form_Checking;
|
||||
|
||||
#The goal of this test is to verify that SelectBox form elements work
|
||||
|
|
@ -29,19 +28,27 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
BOX1 => [ [qw/a/], 'a', 'return a scalar', 'SCALAR'],
|
||||
BOX2 => [ [qw/z y x/], 'z', 'first element', 'SCALAR'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'Box1',
|
||||
testValue => [qw/a/],
|
||||
expected => 'a',
|
||||
comment => 'return a scalar',
|
||||
dataType => 'SCALAR',
|
||||
},
|
||||
{
|
||||
key => 'Box2',
|
||||
testValue => [qw/ z y x/],
|
||||
expected => 'z',
|
||||
comment => 'first element',
|
||||
dataType => 'SCALAR',
|
||||
},
|
||||
];
|
||||
|
||||
my $formClass = 'WebGUI::Form::SelectBox';
|
||||
my $formType = 'SelectBox';
|
||||
|
||||
my $numTests = 9 + scalar keys %testBlock;
|
||||
my $numTests = 9 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -102,4 +109,4 @@ is($input->{size}, 5, 'set size');
|
|||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, %testBlock);
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, $testBlock);
|
||||
|
|
|
|||
|
|
@ -29,21 +29,41 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
LIST1 => [ [qw/a/], 'a', 'single element array, scalar', 'SCALAR'],
|
||||
LIST2 => [ [qw/a/], 'EQUAL', 'single element array, array', 'ARRAY'],
|
||||
LIST3 => [ [qw/a b c/], "a\nb\nc", 'multi element array, scalar', 'SCALAR'],
|
||||
LIST4 => [ [qw/a b c/], 'EQUAL', 'multi element array, array', 'ARRAY'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'List1',
|
||||
testValue => [qw/a/],
|
||||
expected => 'a',
|
||||
comment => 'single element array, scalar',
|
||||
dataType => 'SCALAR'
|
||||
},
|
||||
{
|
||||
key => 'List2',
|
||||
testValue => [qw/a/],
|
||||
expected => 'EQUAL',
|
||||
comment => 'single element array, array',
|
||||
dataType => 'ARRAY'
|
||||
},
|
||||
{
|
||||
key => 'List3',
|
||||
testValue => [qw/a b c/],
|
||||
expected => "a\nb\nc",
|
||||
comment => 'multi element array, scalar',
|
||||
dataType => 'SCALAR'
|
||||
},
|
||||
{
|
||||
key => 'List4',
|
||||
testValue => [qw/a b c/],
|
||||
expected => 'EQUAL',
|
||||
comment => 'multi element array, array',
|
||||
dataType => 'ARRAY'
|
||||
},
|
||||
];
|
||||
|
||||
my $formClass = 'WebGUI::Form::SelectList';
|
||||
my $formType = 'SelectList';
|
||||
|
||||
my $numTests = 11 + scalar keys %testBlock;
|
||||
my $numTests = 11 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -142,4 +162,4 @@ cmp_set([ $form->param('ListMultiple') ], [qw(a b c d e)], 'sorted value check')
|
|||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, %testBlock);
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, $testBlock);
|
||||
|
|
|
|||
|
|
@ -17,7 +17,6 @@ use WebGUI::Form;
|
|||
use WebGUI::Form::Text;
|
||||
use WebGUI::Session;
|
||||
use HTML::Form;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::Form_Checking;
|
||||
|
||||
#The goal of this test is to verify that Text form elements work
|
||||
|
|
@ -28,18 +27,24 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
TestText => [ 'some user value', 'EQUAL', 'Regular text'],
|
||||
TestText2 => [ "some user value\nwith\r\nwhitespace", "some user valuewithwhitespace", 'Embedded whitespace is stripped'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'Text1',
|
||||
testValue => 'some user value',
|
||||
expected => 'EQUAL',
|
||||
comment => 'Regular text',
|
||||
},
|
||||
{
|
||||
key => 'Text2',
|
||||
testValue => "some user value\nwith\r\nwhitespace",
|
||||
expected => "some user valuewithwhitespace",
|
||||
comment => 'Embedded whitespace is stripped',
|
||||
},
|
||||
];
|
||||
|
||||
my $formType = 'text';
|
||||
|
||||
my $numTests = 12 + scalar keys %testBlock;
|
||||
my $numTests = 12 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -97,4 +102,4 @@ is($input->{maxlength}, 200, 'Checking maxlength param, set');
|
|||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, %testBlock);
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, $testBlock);
|
||||
|
|
|
|||
|
|
@ -17,7 +17,6 @@ use WebGUI::Form;
|
|||
use WebGUI::Form::Textarea;
|
||||
use WebGUI::Session;
|
||||
use HTML::Form;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::Form_Checking;
|
||||
|
||||
#The goal of this test is to verify that Textarea form elements work
|
||||
|
|
@ -28,18 +27,24 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
TestText => [ 'some user value', 'EQUAL', 'Regular text'],
|
||||
TestText2 => [ "some user value\nwith\r\nwhitespace", 'EQUAL', 'Embedded whitespace is left'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'Text1',
|
||||
testValue => 'some user value',
|
||||
expected => 'EQUAL',
|
||||
comment => 'Regular text',
|
||||
},
|
||||
{
|
||||
key => 'Text2',
|
||||
testValue => "some user value\nwith\r\nwhitespace",
|
||||
expected => "EQUAL",
|
||||
comment => 'Embedded whitespace is left',
|
||||
},
|
||||
];
|
||||
|
||||
my $formType = 'textarea';
|
||||
|
||||
my $numTests = 14 + scalar keys %testBlock;
|
||||
my $numTests = 14 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -97,4 +102,4 @@ is($input->{wrap}, 'off', 'set wrap to off');
|
|||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, %testBlock);
|
||||
WebGUI::Form_Checking::auto_check($session, $formType, $testBlock);
|
||||
|
|
|
|||
62
t/Form/Url.t
62
t/Form/Url.t
|
|
@ -17,7 +17,6 @@ use WebGUI::Form;
|
|||
use WebGUI::Form::Url;
|
||||
use WebGUI::Session;
|
||||
use HTML::Form;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::Form_Checking;
|
||||
|
||||
#The goal of this test is to verify that Url form elements work
|
||||
|
|
@ -28,23 +27,54 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
Email1 => [ 'mailto:whatever', 'EQUAL', 'mailto processing'],
|
||||
Email2 => [ 'me@nowhere.com', 'mailto:me@nowhere.com', 'email address processing'],
|
||||
Email3 => [ '/', 'EQUAL', 'Url'],
|
||||
Email4 => [ '://', 'EQUAL', 'colon'],
|
||||
Email5 => [ '^', 'EQUAL', 'caret'],
|
||||
Email6 => [ 'mySite', 'http://mySite', 'bare hostname'],
|
||||
Email7 => [ '??**()!!', 'http://??**()!!', 'WRONG: random crap is passed through'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'Url1',
|
||||
testValue => 'mailto:whatever',
|
||||
expected => 'EQUAL',
|
||||
comment => 'mailto processing',
|
||||
},
|
||||
{
|
||||
key => 'Url2',
|
||||
testValue => 'me@nowhere.com',
|
||||
expected => 'mailto:me@nowhere.com',
|
||||
comment => 'email address processing',
|
||||
},
|
||||
{
|
||||
key => 'Url3',
|
||||
testValue => '/',
|
||||
expected => 'EQUAL',
|
||||
comment => 'Bare slash',
|
||||
},
|
||||
{
|
||||
key => 'Url4',
|
||||
testValue => '://',
|
||||
expected => 'EQUAL',
|
||||
comment => 'colon slash slash',
|
||||
},
|
||||
{
|
||||
key => 'Url5',
|
||||
testValue => '^',
|
||||
expected => 'EQUAL',
|
||||
comment => 'caret',
|
||||
},
|
||||
{
|
||||
key => 'Url6',
|
||||
testValue => 'mySite',
|
||||
expected => 'http://mySite',
|
||||
comment => 'bare hostname',
|
||||
},
|
||||
{
|
||||
key => 'Url7',
|
||||
testValue => '??**()!!',
|
||||
expected => 'http://??**()!!',
|
||||
comment => 'WRONG: random crap is passed through',
|
||||
},
|
||||
];
|
||||
|
||||
my $formClass = 'WebGUI::Form::Url';
|
||||
|
||||
my $numTests = 12 + scalar keys %testBlock;
|
||||
my $numTests = 12 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -102,4 +132,4 @@ is($input->{maxlength}, 1024, 'set maxlength');
|
|||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, 'Url', %testBlock);
|
||||
WebGUI::Form_Checking::auto_check($session, 'Url', $testBlock);
|
||||
|
|
|
|||
|
|
@ -17,7 +17,6 @@ use WebGUI::Form;
|
|||
use WebGUI::Form::Zipcode;
|
||||
use WebGUI::Session;
|
||||
use HTML::Form;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::Form_Checking;
|
||||
|
||||
#The goal of this test is to verify that Zipcode form elements work
|
||||
|
|
@ -28,21 +27,42 @@ my $session = WebGUI::Test->session;
|
|||
|
||||
# put your tests here
|
||||
|
||||
my %testBlock;
|
||||
|
||||
tie %testBlock, 'Tie::IxHash';
|
||||
|
||||
%testBlock = (
|
||||
Zip1 => [ 'ABCDE', 'EQUAL', 'alpha'],
|
||||
Zip2 => [ '02468', 'EQUAL', 'numeric'],
|
||||
Zip3 => [ 'NO WHERE', 'EQUAL', 'alpha space'],
|
||||
Zip4 => [ '-', 'EQUAL', 'base dash'],
|
||||
Zip5 => [ 'abcde', undef, 'lower case'],
|
||||
);
|
||||
my $testBlock = [
|
||||
{
|
||||
key => 'Zip1',
|
||||
testValue => 'ABCDE',
|
||||
expected => 'EQUAL',
|
||||
comment => 'alpha',
|
||||
},
|
||||
{
|
||||
key => 'Zip2',
|
||||
testValue => '02468',
|
||||
expected => 'EQUAL',
|
||||
comment => 'numeric',
|
||||
},
|
||||
{
|
||||
key => 'Zip3',
|
||||
testValue => 'NO WHERE',
|
||||
expected => 'EQUAL',
|
||||
comment => 'alpha space',
|
||||
},
|
||||
{
|
||||
key => 'Zip4',
|
||||
testValue => '-',
|
||||
expected => 'EQUAL',
|
||||
comment => 'bare dash',
|
||||
},
|
||||
{
|
||||
key => 'Zip5',
|
||||
testValue => 'abcde',
|
||||
expected => undef,
|
||||
comment => 'lower case',
|
||||
},
|
||||
];
|
||||
|
||||
my $formClass = 'WebGUI::Form::Zipcode';
|
||||
|
||||
my $numTests = 14 + scalar keys %testBlock;
|
||||
my $numTests = 14 + scalar @{ $testBlock } + 1;
|
||||
|
||||
diag("Planning on running $numTests tests\n");
|
||||
|
||||
|
|
@ -77,10 +97,6 @@ is($input->disabled, undef, 'Disabled param not sent to form');
|
|||
is($input->{size}, 30, 'Checking size param, default');
|
||||
is($input->{maxlength}, 10, 'Checking maxlength param, default');
|
||||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, 'Zipcode', %testBlock);
|
||||
|
||||
$html = join "\n",
|
||||
$header,
|
||||
$formClass->new($session, {
|
||||
|
|
@ -100,3 +116,7 @@ is($input->value, '97229-MXIM', 'Checking default value');
|
|||
is($input->disabled, undef, 'Disabled param not sent to form');
|
||||
is($input->{size}, 12, 'Checking size param, default');
|
||||
is($input->{maxlength}, 13, 'Checking maxlength param, default');
|
||||
|
||||
##Test Form Output parsing
|
||||
|
||||
WebGUI::Form_Checking::auto_check($session, 'Zipcode', $testBlock);
|
||||
|
|
|
|||
|
|
@ -5,35 +5,40 @@ use Test::More;
|
|||
use Test::Deep;
|
||||
|
||||
sub auto_check {
|
||||
my ($session, $formType, %testBlock) = @_;
|
||||
my ($session, $formType, $testBlock) = @_;
|
||||
my $origSessionRequest = $session->{_request};
|
||||
|
||||
##Create a by-name interface to the test to simplify the
|
||||
##mocked request.
|
||||
my %tests = map { $_->{key} => $_ } @{ $testBlock };
|
||||
is(scalar keys %tests, scalar @{ $testBlock }, 'no collisions in testBlock');
|
||||
|
||||
my $request = Test::MockObject->new;
|
||||
$request->mock('body',
|
||||
sub {
|
||||
my ($self, $value) = @_;
|
||||
return unless exists $testBlock{$value};
|
||||
if (ref $testBlock{$value}->[0] eq "ARRAY") {
|
||||
return @{ $testBlock{$value}->[0] };
|
||||
return unless exists $tests{$value};
|
||||
if (ref $tests{$value}->{testValue} eq "ARRAY") {
|
||||
return @{ $tests{$value}->{testValue} } ;
|
||||
}
|
||||
else {
|
||||
return $testBlock{$value}->[0];
|
||||
return $tests{$value}->{testValue};
|
||||
}
|
||||
}
|
||||
);
|
||||
|
||||
$session->{_request} = $request;
|
||||
|
||||
foreach my $key (keys %testBlock) {
|
||||
my ($testValue, $expected, $comment, $dataType) = @{ $testBlock{$key} };
|
||||
$dataType ||= 'SCALAR';
|
||||
if ($dataType eq 'SCALAR') {
|
||||
my $value = $session->form->get($key, $formType);
|
||||
is($value, ($expected eq 'EQUAL' ? $testValue : $expected), $comment);
|
||||
foreach my $test ( @{ $testBlock } ) {
|
||||
$test->{dataType} ||= 'SCALAR';
|
||||
$test->{expected} = $test->{testValue} if $test->{expected} eq 'EQUAL';
|
||||
if ($test->{dataType} eq 'SCALAR') {
|
||||
my $value = $session->form->get($test->{key}, $formType);
|
||||
is($value, $test->{expected}, $test->{comment});
|
||||
}
|
||||
elsif ($dataType eq 'ARRAY') {
|
||||
my @value = $session->form->get($key, $formType);
|
||||
cmp_bag(\@value, ($expected eq 'EQUAL' ? $testValue : $expected), $comment);
|
||||
elsif ($test->{dataType} eq 'ARRAY') {
|
||||
my @value = $session->form->get($test->{key}, $formType);
|
||||
cmp_bag(\@value, $test->{expected}, $test->{comment});
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue