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