1#!perl 2 3BEGIN { 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 16use File::Path; 17use File::Copy; 18use Config; 19use Cwd; 20use strict; 21 22$| = 1; 23 24my $cwd = cwd(); 25 26my $testdir = "t e s t"; 27my $exename = "showav"; 28my $plxname = "showargv"; 29rmtree($testdir); 30mkdir($testdir); 31die "Could not create '$testdir':$!" unless -d $testdir; 32 33open(my $F, ">$testdir/$exename.c") 34 or die "Can't create $testdir/$exename.c: $!"; 35print $F <<'EOT'; 36#include <stdio.h> 37#ifdef __BORLANDC__ 38#include <windows.h> 39#endif 40int 41main(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} 64EOT 65 66open($F, ">$testdir/$plxname.bat") 67 or die "Can't create $testdir/$plxname.bat: $!"; 68print $F <<'EOT'; 69@rem = '--*-Perl-*-- 70@echo off 71if "%OS%" == "Windows_NT" goto WinNT 72EOT 73 74print $F <<EOT; 75"$^X" -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9 76goto endofperl 77:WinNT 78"$^X" -x -S %0 %* 79EOT 80print $F <<'EOT'; 81if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl 82if %errorlevel% == 9009 echo You do not have Perl in your PATH. 83if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul 84goto endofperl 85@rem '; 86#!perl 87#line 15 88print "[$_]" for ($0, @ARGV); 89print "\n"; 90__END__ 91:endofperl 92EOT 93 94close $F; 95 96# build the executable 97chdir($testdir); 98END { 99 chdir($cwd) && rmtree("$cwd/$testdir") if -d "$cwd/$testdir"; 100} 101if (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} 114else { 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} 139copy("$plxname.bat","$plxname.cmd"); 140chdir($cwd); 141unless (-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 147open my $T, "$^X -I../lib -w win32/system_tests |" 148 or die "Can't spawn win32/system_tests: $!"; 149my $expect; 150my $comment = ""; 151my $test = 0; 152while (<$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} 176close $T; 177