FAQ sync.
[p5sagit/p5-mst-13.2.git] / lib / CGI / t / util.t
1 #!/usr/local/bin/perl -w
2
3 BEGIN {
4         chdir 't' if -d 't';
5         if ($ENV{PERL_CORE}) {
6                 @INC = '../lib';
7         } else {
8                 unshift @INC, qw( ../blib/lib ../blib/arch lib );
9         }
10 }
11
12 # Test ability to escape() and unescape() punctuation characters
13 # except for qw(- . _).
14 ######################### We start with some black magic to print on failure.
15 BEGIN {$| = 1; print "1..59\n"; }
16 END {print "not ok 1\n" unless $loaded;}
17 use Config;
18 use CGI::Util qw(escape unescape);
19 $loaded = 1;
20 print "ok 1\n";
21
22 ######################### End of black magic.
23
24 # util
25 sub test {
26     local($^W) = 0;
27     my($num, $true,$msg) = @_;
28     print($true ? "ok $num\n" : "not ok $num $msg\n");
29 }
30
31 # ASCII order, ASCII codepoints, ASCII repertoire
32
33 my %punct = (
34     ' ' => '20',  '!' => '21',  '"' => '22',  '#' =>  '23', 
35     '$' => '24',  '%' => '25',  '&' => '26',  '\'' => '27', 
36     '(' => '28',  ')' => '29',  '*' => '2A',  '+' =>  '2B', 
37     ',' => '2C',                              '/' =>  '2F',  # '-' => '2D',  '.' => '2E' 
38     ':' => '3A',  ';' => '3B',  '<' => '3C',  '=' =>  '3D', 
39     '>' => '3E',  '?' => '3F',  '[' => '5B',  '\\' => '5C', 
40     ']' => '5D',  '^' => '5E',                '`' =>  '60',  # '_' => '5F',
41     '{' => '7B',  '|' => '7C',  '}' => '7D',  '~' =>  '7E', 
42          );
43
44 # The sort order may not be ASCII on EBCDIC machines:
45
46 my $i = 1;
47
48 foreach(sort(keys(%punct))) { 
49     $i++;
50     my $escape = "AbC\%$punct{$_}dEF";
51     my $cgi_escape = escape("AbC$_" . "dEF");
52     test($i, $escape eq $cgi_escape , "# $escape ne $cgi_escape");
53     $i++;
54     my $unescape = "AbC$_" . "dEF";
55     my $cgi_unescape = unescape("AbC\%$punct{$_}dEF");
56     test($i, $unescape eq $cgi_unescape , "# $unescape ne $cgi_unescape");
57 }
58