Rietveld Code Review Tool
Help | Bug tracker | Discussion group | Source code | Sign in
(331)

Side by Side Diff: src/pkg/net/http/cgi/testdata/test.cgi

Issue 6842066: code review 6842066: net/http/cgi: more windows perl test work (Closed)
Patch Set: diff -r 3d3b1e3f5268 https://go.googlecode.com/hg/ Created 11 years, 4 months ago
Left:
Right:
Use n/p to move between diff chunks; N/P to move between comments. Please Sign in to add in-line comments.
Jump to:
View unified diff | Download patch
« no previous file with comments | « no previous file | no next file » | no next file with comments »
Toggle Intra-line Diffs ('i') | Expand Comments ('e') | Collapse Comments ('c') | Show Comments Hide Comments ('s')
OLDNEW
1 #!/usr/bin/perl 1 #!/usr/bin/perl
2 # Copyright 2011 The Go Authors. All rights reserved. 2 # Copyright 2011 The Go Authors. All rights reserved.
3 # Use of this source code is governed by a BSD-style 3 # Use of this source code is governed by a BSD-style
4 # license that can be found in the LICENSE file. 4 # license that can be found in the LICENSE file.
5 # 5 #
6 # Test script run as a child process under cgi_test.go 6 # Test script run as a child process under cgi_test.go
7 7
8 use strict; 8 use strict;
9 use Cwd; 9 use Cwd;
10 10
11 binmode STDOUT; 11 binmode STDOUT;
12 12
13 sub on_windows {
14 return $^O eq 'MSWin32' || $^O eq 'msys';
15 }
16
17 # normalize_windows_path normalizes the various Windows Perl path
18 # formats into Go's format.
19 sub normalize_windows_path {
20 my $dir = shift;
21 return $dir unless on_windows();
22 print "from $dir\n";
mkrautz 2012/11/19 18:33:39 Debug print?
23 $dir =~ s!^[a-z]:!uc($&)!e;
24 print " to $dir\n";
mkrautz 2012/11/19 18:33:39 Ditto.
25 if ($dir =~ s!^/([a-zA-Z])/!!) {
26 $dir = uc($1) . ":\\$dir";
27 }
28 print " to $dir\n";
mkrautz 2012/11/19 18:33:39 Ditto.
29 $dir =~ s!/!\\!g;
30 print " to $dir\n";
mkrautz 2012/11/19 18:33:39 Ditto.
31 return $dir;
32 }
33
13 my $q = MiniCGI->new; 34 my $q = MiniCGI->new;
14 my $params = $q->Vars; 35 my $params = $q->Vars;
15 36
16 if ($params->{"loc"}) { 37 if ($params->{"loc"}) {
17 print "Location: $params->{loc}\r\n\r\n"; 38 print "Location: $params->{loc}\r\n\r\n";
18 exit(0); 39 exit(0);
19 } 40 }
20 41
21 my $NL = "\r\n"; 42 my $NL = "\r\n";
22 $NL = "\n" if $params->{mode} eq "NL"; 43 $NL = "\n" if $params->{mode} eq "NL";
23 44
24 my $p = sub { 45 my $p = sub {
25 print "$_[0]$NL"; 46 print "$_[0]$NL";
26 }; 47 };
27 48
28 # With carriage returns 49 # With carriage returns
29 $p->("Content-Type: text/html"); 50 $p->("Content-Type: text/html");
30 $p->("X-CGI-Pid: $$"); 51 $p->("X-CGI-Pid: $$");
31 $p->("X-Test-Header: X-Test-Value"); 52 $p->("X-Test-Header: X-Test-Value");
32 $p->(""); 53 $p->("");
33 54
34 if ($params->{"bigresponse"}) { 55 if ($params->{"bigresponse"}) {
35 for (1..1024) { 56 for (1..1024) {
36 print "A" x 1024, "\n"; 57 print "A" x 1024, "\n";
37 } 58 }
38 exit 0; 59 exit 0;
39 } 60 }
40 61
41 print "test=Hello CGI\n"; 62 print "test=Hello CGI\n";
42 63
43 foreach my $k (sort keys %$params) { 64 foreach my $k (sort keys %$params) {
44 print "param-$k=$params->{$k}\n"; 65 print "param-$k=$params->{$k}\n";
45 } 66 }
46 67
47 foreach my $k (sort keys %ENV) { 68 foreach my $k (sort keys %ENV) {
48 my $clean_env = $ENV{$k}; 69 my $clean_env = $ENV{$k};
49 $clean_env =~ s/[\n\r]//g; 70 $clean_env =~ s/[\n\r]//g;
50 print "env-$k=$clean_env\n"; 71 print "env-$k=$clean_env\n";
51 } 72 }
52 73
53 # NOTE: don't call getcwd() for windows. 74 my $dir = ::normalize_windows_path(getcwd());
54 # msys return /c/go/src/... not C:\go\...
55 my $dir;
56 if ($^O eq 'MSWin32' || $^O eq 'msys') {
57 my $cmd = $ENV{'COMSPEC'} || 'c:\\windows\\system32\\cmd.exe';
58 $cmd =~ s!\\!/!g;
59 $dir = `$cmd /c cd`;
60 chomp $dir;
61 } else {
62 $dir = getcwd();
63 }
64 print "cwd=$dir\n"; 75 print "cwd=$dir\n";
65 76
66
67 # A minimal version of CGI.pm, for people without the perl-modules 77 # A minimal version of CGI.pm, for people without the perl-modules
68 # package installed. (CGI.pm used to be part of the Perl core, but 78 # package installed. (CGI.pm used to be part of the Perl core, but
69 # some distros now bundle perl-base and perl-modules separately...) 79 # some distros now bundle perl-base and perl-modules separately...)
70 package MiniCGI; 80 package MiniCGI;
71 81
72 sub new { 82 sub new {
73 my $class = shift; 83 my $class = shift;
74 return bless {}, $class; 84 return bless {}, $class;
75 } 85 }
76 86
(...skipping 12 matching lines...) Expand all
89 } 99 }
90 return $vars; 100 return $vars;
91 } 101 }
92 102
93 sub _urldecode { 103 sub _urldecode {
94 my $v = shift; 104 my $v = shift;
95 $v =~ tr/+/ /; 105 $v =~ tr/+/ /;
96 $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; 106 $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
97 return $v; 107 return $v;
98 } 108 }
109
110 package Tests;
111
112 sub test_normalize_windows_paths {
113 my @tests = (
114 {in => "C:\\foo\\bar", want => "C:\\foo\\bar"},
115 {in => "C:/foo/bar", want => "C:\\foo\\bar"},
116 {in => "c:/foo/bar", want => "C:\\foo\\bar"},
117 {in => "/c/foo/bar", want => "C:\\foo\\bar"},
118 );
119 foreach my $tt (@tests) {
120 my $got = ::normalize_windows_path($tt->{in});
121 unless ($got eq $tt->{want}) {
122 die "For path $tt->{in}, normalize = $got; want $tt->{want}\n";
123 }
124 }
125 }
126
127 BEGIN {
128 test_normalize_windows_paths() if ::on_windows();
129 }
OLDNEW
« no previous file with comments | « no previous file | no next file » | no next file with comments »

Powered by Google App Engine
RSS Feeds Recent Issues | This issue
This is Rietveld f62528b