t/win32/system_tests

   1 #!perl
   2
   3 use Config;
   4 use Cwd;
   5 use strict;
   6 BEGIN {
   7     require './test.pl';
   8 }
   9
  10 $| = 1;
  11
  12 my $cwdb = my $cwd = cwd();
  13 $cwd =~ s,\\,/,g;
  14 $cwdb =~ s,/,\\,g;
  15
  16 my $testdir = "t e s t";
  17 my $exename = "showav";
  18 my $plxname = "showargv";
  19
  20 my $exe = "$testdir/$exename";
  21 my $exex = $exe . ".exe";
  22 (my $exeb = $exe) =~ s,/,\\,g;
  23 my $exebx = $exeb . ".exe";
  24
  25 my $bat = "$testdir/$plxname";
  26 my $batx = $bat . ".bat";
  27 (my $batb = $bat) =~ s,/,\\,g;
  28 my $batbx = $batb . ".bat";
  29
  30 my $cmdx = $bat . ".cmd";
  31 my $cmdb = $batb;
  32 my $cmdbx = $cmdb . ".cmd";
  33
  34 my @commands = (
  35   $exe,
  36   $exex,
  37   $exeb,
  38   $exebx,
  39   "./$exe",
  40   "./$exex",
  41   ".\\$exeb",
  42   ".\\$exebx",
  43   "$cwd/$exe",
  44   "$cwd/$exex",
  45   "$cwdb\\$exeb",
  46   "$cwdb\\$exebx",
  47   $bat,
  48   $batx,
  49   $batb,
  50   $batbx,
  51   "./$bat",
  52   "./$batx",
  53   ".\\$batb",
  54   ".\\$batbx",
  55   "$cwd/$bat",
  56   "$cwd/$batx",
  57   "$cwdb\\$batb",
  58   "$cwdb\\$batbx",
  59   $cmdx,
  60   $cmdbx,
  61   "./$cmdx",
  62   ".\\$cmdbx",
  63   "$cwd/$cmdx",
  64   "$cwdb\\$cmdbx",
  65   [$^X, $batx],
  66   [$^X, $batbx],
  67   [$^X, "./$batx"],
  68   [$^X, ".\\$batbx"],
  69   [$^X, "$cwd/$batx"],
  70   [$^X, "$cwdb\\$batbx"],
  71 );
  72
  73 my @av = (
  74   undef,
  75   "",
  76   " ",
  77   "abc",
  78   "a b\tc",
  79   "\tabc",
  80   "abc\t",
  81   " abc\t",
  82   "\ta b c ",
  83   ["\ta b c ", ""],
  84   ["\ta b c ", " "],
  85   ["", "\ta b c ", "abc"],
  86   [" ", "\ta b c ", "abc"],
  87   ['" "', 'a" "b" "c', "abc"],
  88 );
  89
  90 print "1.." . (@commands * @av * 3) . "\n";
  91 for my $cmds (@commands) {
  92     for my $args (@av) {
  93         my @all_args;
  94         my @cmds = defined($cmds) ? (ref($cmds) ? @$cmds : $cmds) : ();
  95         my @args = defined($args) ? (ref($args) ? @$args : $args) : ();
  96         note "####### [@cmds]";
  97         print "<", join('><',
  98                         $cmds[$#cmds],
  99                         map { my $x = $_; $x =~ s/"//g; $x } @args),
 100               ">\n";
 101         if (system(@cmds,@args) != 0) {
 102             print "Failed, status($?)\n";
 103             if ($Config{ccflags} =~ /\bDDEBUGGING\b/) {
 104                 print "Running again in debug mode\n";
 105                 $^D = 1; # -Dp
 106                 system(@cmds,@args);
 107             }
 108         }
 109         $^D = 0;
 110         my $cmdstr = join " ", map { /\s|^$/ && !/\"/
 111                                     ? qq["$_"] : $_ } @cmds, @args;
 112         note "####### '$cmdstr'";
 113         if (system($cmdstr) != 0) {
 114             print "Failed, status($?)\n";
 115             if ($Config{ccflags} =~ /\bDDEBUGGING\b/) {
 116                 print "Running again in debug mode\n";
 117                 $^D = 1; # -Dp
 118                 system($cmdstr);
 119             }
 120         }
 121         $^D = 0;
 122
 123         note "# pipe [".join(";", @cmds, @args). "]";
 124         if (open my $io, "|-", @cmds, @args) {
 125             print <$io>;
 126             close $io;
 127         }
 128         else {
 129             print "Failed pipe open: $!\n";
 130         }
 131     }
 132 }