This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix another Win32 breakage caused by change 23554
[perl5.git] / t / win32 / system.t
1 #!perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     # We need '../../lib' as well as '../lib' because parts of Config are
6     # delay-loaded, after we've chdir()'ed into $testdir.
7     @INC = ('../lib', '../../lib');
8     # XXX this could be further munged to enable some parts on other
9     # platforms
10     unless ($^O =~ /^MSWin/) {
11         print "1..0 # skipped: windows specific test\n";
12         exit 0;
13     }
14 }
15
16 use File::Path;
17 use File::Copy;
18 use Config;
19 use Cwd;
20 use strict;
21
22 $| = 1;
23
24 my $cwd = cwd();
25
26 my $testdir = "t e s t";
27 my $exename = "showav";
28 my $plxname = "showargv";
29 rmtree($testdir);
30 mkdir($testdir);
31 die "Could not create '$testdir':$!" unless -d $testdir;
32
33 open(my $F, ">$testdir/$exename.c")
34     or die "Can't create $testdir/$exename.c: $!";
35 print $F <<'EOT';
36 #include <stdio.h>
37 #ifdef __BORLANDC__
38 #include <windows.h>
39 #endif
40 int
41 main(int ac, char **av)
42 {
43     int i;
44 #ifdef __BORLANDC__
45     char *s = GetCommandLine();
46     int j=0;
47     av[0] = s;
48     if (s[0]=='"') {
49         for(;s[++j]!='"';)
50           ;
51         av[0]++;
52     }
53     else {
54         for(;s[++j]!=' ';)
55           ;
56     }
57     s[j]=0;
58 #endif
59     for (i = 0; i < ac; i++)
60         printf("[%s]", av[i]);
61     printf("\n");
62     return 0;
63 }
64 EOT
65
66 open($F, ">$testdir/$plxname.bat")
67     or die "Can't create $testdir/$plxname.bat: $!";
68 print $F <<'EOT';
69 @rem = '--*-Perl-*--
70 @echo off
71 if "%OS%" == "Windows_NT" goto WinNT
72 EOT
73
74 print $F <<EOT;
75 "$^X" -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
76 goto endofperl
77 :WinNT
78 "$^X" -x -S %0 %*
79 EOT
80 print $F <<'EOT';
81 if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
82 if %errorlevel% == 9009 echo You do not have Perl in your PATH.
83 if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
84 goto endofperl
85 @rem ';
86 #!perl
87 #line 15
88 print "[$_]" for ($0, @ARGV);
89 print "\n";
90 __END__
91 :endofperl
92 EOT
93
94 close $F;
95
96 # build the executable
97 chdir($testdir);
98 END {
99     chdir($cwd) && rmtree("$cwd/$testdir") if -d "$cwd/$testdir";
100 }
101 if (open(my $EIN, "$cwd/win32/${exename}_exe.uu")) {
102     print "# Unpacking $exename.exe\n";
103     my $e;
104     {
105         local $/;
106         $e = unpack "u", <$EIN>;
107         close $EIN;
108     }
109     open my $EOUT, ">$exename.exe" or die "Can't write $exename.exe: $!";
110     binmode $EOUT;
111     print $EOUT $e;
112     close $EOUT;
113 }
114 else {
115     my $minus_o = '';
116     if ($Config{cc} eq 'gcc')
117      {
118       $minus_o = "-o $exename.exe";
119      }
120     print "# Compiling $exename.c\n# $Config{cc} $Config{ccflags} $exename.c\n";
121     if (system("$Config{cc} $Config{ccflags} $minus_o $exename.c >log 2>&1") != 0) {
122         print "# Could not compile $exename.c, status $?\n"
123              ."# Where is your C compiler?\n"
124              ."1..0 # skipped: can't build test executable\n";
125         exit(0);
126     }
127     unless (-f "$exename.exe") {
128         if (open(LOG,'<log'))
129          {
130           while(<LOG>) {
131              print "# ",$_;
132           } 
133          }
134         else {
135           warn "Cannot open log (in $testdir):$!";
136         }
137     }
138 }
139 copy("$plxname.bat","$plxname.cmd");
140 chdir($cwd);
141 unless (-x "$testdir/$exename.exe") {
142     print "# Could not build $exename.exe\n"
143          ."1..0 # skipped: can't build test executable\n";
144     exit(0);
145 }
146
147 open my $T, "$^X -I../lib -w win32/system_tests |"
148     or die "Can't spawn win32/system_tests: $!";
149 my $expect;
150 my $comment = "";
151 my $test = 0;
152 while (<$T>) {
153     chomp;
154     if (/^1\.\./) {
155         print "$_\n";
156     }
157     elsif (/^#+\s(.*)$/) {
158         $comment = $1;
159     }
160     elsif (/^</) {
161         $expect = $_;
162         $expect =~ tr/<>/[]/;
163         $expect =~ s/\Q$plxname\E]/$plxname.bat]/;
164     }
165     else {
166         if ($expect ne $_) {
167             print "# $comment\n" if $comment;
168             print "# want: $expect\n";
169             print "# got : $_\n";
170             print "not ";
171         }
172         ++$test;
173         print "ok $test\n";
174     }
175 }
176 close $T;