| 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 | }
|
|---|
