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