t/win32/system_tests

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