xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/CGI/t/util.t (revision 6287:9a1f5d2c8dd8)
10Sstevel@tonic-gate#!/usr/local/bin/perl -w
20Sstevel@tonic-gate
30Sstevel@tonic-gate# Test ability to escape() and unescape() punctuation characters
40Sstevel@tonic-gate# except for qw(- . _).
50Sstevel@tonic-gate######################### We start with some black magic to print on failure.
60Sstevel@tonic-gateuse lib '../blib/lib','../blib/arch';
70Sstevel@tonic-gate
8*6287Sps156622BEGIN {$| = 1; print "1..57\n"; }
90Sstevel@tonic-gateEND {print "not ok 1\n" unless $loaded;}
100Sstevel@tonic-gateuse Config;
110Sstevel@tonic-gateuse CGI::Util qw(escape unescape);
120Sstevel@tonic-gate$loaded = 1;
130Sstevel@tonic-gateprint "ok 1\n";
140Sstevel@tonic-gate
150Sstevel@tonic-gate######################### End of black magic.
160Sstevel@tonic-gate
170Sstevel@tonic-gate# util
180Sstevel@tonic-gatesub test {
190Sstevel@tonic-gate    local($^W) = 0;
200Sstevel@tonic-gate    my($num, $true,$msg) = @_;
210Sstevel@tonic-gate    print($true ? "ok $num\n" : "not ok $num $msg\n");
220Sstevel@tonic-gate}
230Sstevel@tonic-gate
240Sstevel@tonic-gate# ASCII order, ASCII codepoints, ASCII repertoire
250Sstevel@tonic-gate
260Sstevel@tonic-gatemy %punct = (
270Sstevel@tonic-gate    ' ' => '20',  '!' => '21',  '"' => '22',  '#' =>  '23',
280Sstevel@tonic-gate    '$' => '24',  '%' => '25',  '&' => '26',  '\'' => '27',
290Sstevel@tonic-gate    '(' => '28',  ')' => '29',  '*' => '2A',  '+' =>  '2B',
300Sstevel@tonic-gate    ',' => '2C',                              '/' =>  '2F',  # '-' => '2D',  '.' => '2E'
310Sstevel@tonic-gate    ':' => '3A',  ';' => '3B',  '<' => '3C',  '=' =>  '3D',
320Sstevel@tonic-gate    '>' => '3E',  '?' => '3F',  '[' => '5B',  '\\' => '5C',
330Sstevel@tonic-gate    ']' => '5D',  '^' => '5E',                '`' =>  '60',  # '_' => '5F',
34*6287Sps156622    '{' => '7B',  '|' => '7C',  '}' => '7D',  # '~' =>  '7E',
350Sstevel@tonic-gate         );
360Sstevel@tonic-gate
370Sstevel@tonic-gate# The sort order may not be ASCII on EBCDIC machines:
380Sstevel@tonic-gate
390Sstevel@tonic-gatemy $i = 1;
400Sstevel@tonic-gate
410Sstevel@tonic-gateforeach(sort(keys(%punct))) {
420Sstevel@tonic-gate    $i++;
430Sstevel@tonic-gate    my $escape = "AbC\%$punct{$_}dEF";
440Sstevel@tonic-gate    my $cgi_escape = escape("AbC$_" . "dEF");
450Sstevel@tonic-gate    test($i, $escape eq $cgi_escape , "# $escape ne $cgi_escape");
460Sstevel@tonic-gate    $i++;
470Sstevel@tonic-gate    my $unescape = "AbC$_" . "dEF";
480Sstevel@tonic-gate    my $cgi_unescape = unescape("AbC\%$punct{$_}dEF");
490Sstevel@tonic-gate    test($i, $unescape eq $cgi_unescape , "# $unescape ne $cgi_unescape");
500Sstevel@tonic-gate}
510Sstevel@tonic-gate
52