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} =~ /\bgcc/i)
 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;