t/win32/system.t

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