Commit | Line | Data |
92dffb52 |
1 | #!/usr/local/bin/perl -w |
2 | |
f0c07f2e |
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 | |
92dffb52 |
12 | # Test ability to escape() and unescape() punctuation characters |
13 | # except for qw(- . _). |
14 | ######################### We start with some black magic to print on failure. |
92dffb52 |
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 | |