net/http/cgi: more windows perl test work

Don't rely on finding cmd.exe in a particular spot.

Fixes #4401

R=golang-dev, krautz
CC=golang-dev
https://golang.org/cl/6842066

diff --git a/src/pkg/net/http/cgi/testdata/test.cgi b/src/pkg/net/http/cgi/testdata/test.cgi
index d74a70239b2d25fc12a57479f58706737dee1c3b..dcefe4e7af55c29d69f6e8157ddf8068c1419b3b 100755 (executable)
--- a/src/pkg/net/http/cgi/testdata/test.cgi
+++ b/src/pkg/net/http/cgi/testdata/test.cgi
@@ -10,6 +10,23 @@ use Cwd;
 
 binmode STDOUT;
 
+sub on_windows {
+    return $^O eq 'MSWin32' || $^O eq 'msys';
+}
+
+# normalize_windows_path normalizes the various Windows Perl path
+# formats into Go's format.
+sub normalize_windows_path {
+    my $dir = shift;
+    return $dir unless on_windows();
+    $dir =~ s!^[a-z]:!uc($&)!e;
+    if ($dir =~ s!^/([a-zA-Z])/!!) {
+        $dir = uc($1) . ":\\$dir";
+    }
+    $dir =~ s!/!\\!g;
+    return $dir;
+}
+
 my $q = MiniCGI->new;
 my $params = $q->Vars;
 
@@ -22,7 +39,7 @@ my $NL = "\r\n";
 $NL = "\n" if $params->{mode} eq "NL";
 
 my $p = sub {
-  print "$_[0]$NL";
+    print "$_[0]$NL";
 };
 
 # With carriage returns
@@ -41,29 +58,18 @@ if ($params->{"bigresponse"}) {
 print "test=Hello CGI\n";
 
 foreach my $k (sort keys %$params) {
-  print "param-$k=$params->{$k}\n";
+    print "param-$k=$params->{$k}\n";
 }
 
 foreach my $k (sort keys %ENV) {
-  my $clean_env = $ENV{$k};
-  $clean_env =~ s/[\n\r]//g;
-  print "env-$k=$clean_env\n";
+    my $clean_env = $ENV{$k};
+    $clean_env =~ s/[\n\r]//g;
+    print "env-$k=$clean_env\n";
 }
 
-# NOTE: don't call getcwd() for windows.
-# msys return /c/go/src/... not C:\go\...
-my $dir;
-if ($^O eq 'MSWin32' || $^O eq 'msys') {
-  my $cmd = $ENV{'COMSPEC'} || 'c:\\windows\\system32\\cmd.exe';
-  $cmd =~ s!\\!/!g;
-  $dir = `$cmd /c cd`;
-  chomp $dir;
-} else {
-  $dir = getcwd();
-}
+my $dir = normalize_windows_path(getcwd());
 print "cwd=$dir\n";
 
-
 # A minimal version of CGI.pm, for people without the perl-modules
 # package installed.  (CGI.pm used to be part of the Perl core, but
 # some distros now bundle perl-base and perl-modules separately...)
@@ -96,3 +102,24 @@ sub _urldecode {
     $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
     return $v;
 }
+
+package Tests;
+
+sub test_normalize_windows_paths {
+    my @tests = (
+        {in => "C:\\foo\\bar", want => "C:\\foo\\bar"},
+        {in => "C:/foo/bar", want => "C:\\foo\\bar"},
+        {in => "c:/foo/bar", want => "C:\\foo\\bar"},
+        {in => "/c/foo/bar", want => "C:\\foo\\bar"},
+    );
+    foreach my $tt (@tests) {
+        my $got = ::normalize_windows_path($tt->{in});
+        unless ($got eq $tt->{want}) {
+            die "For path $tt->{in}, normalize = $got; want $tt->{want}\n";
+        }
+    }
+}
+
+BEGIN {
+    test_normalize_windows_paths() if ::on_windows();
+}