ghc/interpreter/test/runstdtest

   1 #!/usr/bin/perl
   2 #! /usr/local/bin/perl
   3 #
   4 # Given:
   5 #       * a program to run (1st arg)
   6 #       * some "command-line opts" ( -O<opt1> -O<opt2> ... )
   7 #           [default: anything on the cmd line this script doesn't recognise ]
   8 #         the first opt not starting w/ "-" is taken to be an input
   9 #         file and (if it exists) is grepped for "what's going on here"
  10 #         comments (^--!!!).
  11 #       * a file to feed to stdin ( -i<file> ) [default: $dev_null ]
  12 #       * a "time" command to use (-t <cmd>).
  13 #       * a "start" line (-s <line>) - all preceeding lines of output
  14 #       *   are ignored (from stdout).
  15 #       * a "start" pattern (-f <regexp>) - all preceeding lines of output
  16 #       *   are deleted (from stdout).
  17 #       * an "end" pattern (-l <regexp>) - all later lines of output
  18 #       *   are deleted (from stdout).
  19 #
  20 #       * alternatively, a "-script <script>" argument says: run the
  21 #         named Bourne-shell script to do the test.  It's passed the
  22 #         pgm-to-run as the one-and-only arg.
  23 #
  24 # Run the program with those options and that input, and check:
  25 # if we get...
  26 #
  27 #       * an expected exit status ( -x <val> ) [ default 0 ]
  28 #       * expected output on stdout ( -o1 <file> ) [ default $dev_null ]
  29 #               ( we'll accept one of several...)
  30 #       * expected output on stderr ( -o2 <file> ) [ default $dev_null ]
  31 #               ( we'll accept one of several...)
  32 #
  33 #       (if the expected-output files' names end in .Z, then
  34 #        they are uncompressed before doing the comparison)
  35 #
  36 # (This is supposed to be a "prettier" replacement for runstdtest.)
  37 #
  38
  39 die "$0 requires perl 5.0 or higher" unless $] >= 5.0;
  40
  41 ($Pgm = $0) =~ s|.*/||;
  42
  43 $tmpdir   = &fromEnv('TMPDIR',"/tmp");
  44 $shell    = "/bin/sh";
  45 $cmp      = "diff -q";
  46 $diff     = &fromEnv('CONTEXT_DIFF',"diff -c1");
  47 $dev_null = &fromEnv('DEV_NULL',"/dev/null");
  48
  49 $Verbose = 0;
  50 $Status = 0;
  51 @PgmArgs = ();
  52 $PgmExitStatus = 0;
  53 $PgmStdinFile  = $dev_null;
  54 $DefaultStdoutFile = "${tmpdir}/no_stdout$$"; # can't use $dev_null (e.g. Alphas)
  55 $DefaultStderrFile = "${tmpdir}/no_stderr$$";
  56 @PgmStdoutFile = ();
  57 @PgmStderrFile = ();
  58 $PgmStartLine = 0;
  59 $PgmStartPat = '.';
  60 $PgmEndPat   = 'WILLNAEMATCH';  # hack!
  61 $AltScript = '';
  62 $TimeCmd = '';
  63
  64 die "$Pgm: program to run not given as first argument\n" if $#ARGV < 0;
  65 $ToRun = $ARGV[0]; shift(@ARGV);
  66 # avoid picking up same-named thing from somewhere else on $PATH...
  67 $ToRun = "./$ToRun" if $ToRun !~ /^\//;
  68
  69 arg: while ($_ = $ARGV[0]) {
  70     shift(@ARGV);
  71
  72     /^-v$/      && do { $Verbose = 1; next arg; };
  73     /^-O(.*)/   && do { push(@PgmArgs, &grab_arg_arg('-O',$1)); next arg; };
  74     /^-i(.*)/   && do { $PgmStdinFile = &grab_arg_arg('-i',$1);
  75                         $Status++,
  76                         print STDERR "$Pgm: bogus -i input file: $PgmStdinFile\n"
  77                             if ! -f $PgmStdinFile;
  78                         next arg; };
  79     /^-x(.*)/   && do { $PgmExitStatus = &grab_arg_arg('-x',$1);
  80                         $Status++ ,
  81                         print STDERR "$Pgm: bogus -x expected exit status: $PgmExitStatus\n"
  82                             if $PgmExitStatus !~ /^\d+$/;
  83                         next arg; };
  84     /^-s(.*)/   && do { $PgmStartLine = &grab_arg_arg('-x',$1);
  85                         $Status++ ,
  86                         print STDERR "$Pgm: bogus -s start line: $PgmStartLine\n"
  87                             if $PgmStartLine !~ /^\d+$/;
  88                         next arg; };
  89     /^-f(.*)/   && do { $PgmStartPat = &grab_arg_arg('-f',$1);
  90                         next arg; };
  91     /^-l(.*)/   && do { $PgmEndPat = &grab_arg_arg('-l',$1);
  92                         next arg; };
  93     /^-o1(.*)/  && do { $out_file = &grab_arg_arg('-o1',$1);
  94                         $Status++ ,
  95                         print STDERR "$Pgm: bogus -o1 expected-output file: $out_file\n"
  96                             if ! -f $out_file;
  97                         push(@PgmStdoutFile, $out_file);
  98                         next arg; };
  99     /^-o2(.*)/  && do { $out_file = &grab_arg_arg('-o2',$1);
 100                         $Status++,
 101                         print STDERR "$Pgm: bogus -o2 expected-stderr file: $out_file\n"
 102                             if ! -f $out_file;
 103                         push(@PgmStderrFile, $out_file);
 104                         next arg; };
 105     /^-script(.*)/ && do { $AltScript = &grab_arg_arg('-script',$1);
 106                         next arg; };
 107     /^-t(.*)/   && do { $TimeCmd = &grab_arg_arg('-t', $1); next arg; };
 108
 109     # anything else is taken to be a pgm arg
 110     push(@PgmArgs, $_);
 111 }
 112 exit 1 if $Status;
 113
 114 # add on defaults if none specified
 115 @PgmStdoutFile = ( $DefaultStdoutFile ) if $#PgmStdoutFile < 0;
 116 @PgmStderrFile = ( $DefaultStderrFile ) if $#PgmStderrFile < 0;
 117
 118 # tidy up the pgm args:
 119 # (1) look for the "first input file"
 120 #     and grep it for "interesting" comments (--!!! )
 121 # (2) quote any args w/ whitespace in them.
 122 $grep_done = 0;
 123 foreach $a ( @PgmArgs ) {
 124     if (! $grep_done && $a !~ /^-/ && -f $a) {
 125          unless (open(ARG, $a)) {
 126              print STDERR "Can't open $a: $!\n";
 127              exit 1;
 128          }
 129          while (<ARG>) {
 130              print if /^--!!!/;
 131          }
 132          close(ARG);
 133          $grep_done = 1;
 134     }
 135     if ($a =~ /\s/ || $a =~ /'/) {
 136         $a =~ s/'/\\'/g;    # backslash the quotes;
 137         $a =~ s/"/\\"/g;    # backslash the quotes;
 138         $a = "\"$a\"";      # quote the arg
 139     }
 140 }
 141
 142 if ($AltScript ne '') {
 143     local($to_do);
 144     $to_do = `cat $AltScript`;
 145     # glue in pgm to run...
 146     $* = 1;
 147     $to_do =~ s/^\$1 /$ToRun /;
 148     &run_something($to_do);
 149     exit 0;
 150 #    exec "$AltScript $ToRun";
 151 #    print STDERR "Failed to exec!!! $AltScript $ToRun\n";
 152 #    exit 1;
 153 }
 154
 155 # OK, so we're gonna do the normal thing...
 156
 157 $Script = <<EOSCRIPT;
 158 CONTEXT_DIFF='/usr/bin/diff -C 1'
 159 export CONTEXT_DIFF
 160 DEV_NULL='/dev/null'
 161 export DEV_NULL
 162 myexit=0
 163 diffsShown=0
 164 /bin/rm -f $DefaultStdoutFile $DefaultStderrFile
 165 cat $dev_null > $DefaultStdoutFile
 166 cat $dev_null > $DefaultStderrFile
 167 $TimeCmd ${shell} -c \'$ToRun @PgmArgs < $PgmStdinFile 1> ${tmpdir}/runtest$$.1 2> ${tmpdir}/runtest$$.2\'
 168 progexit=\$?
 169 if [ \$progexit -ne $PgmExitStatus ]; then
 170     echo $ToRun @PgmArgs \\< $PgmStdinFile
 171     echo expected exit status $PgmExitStatus not seen \\; got \$progexit
 172     myexit=1
 173 else
 174     # Pipe that filters out stuff we don't want to check
 175     tail +$PgmStartLine ${tmpdir}/runtest$$.1 | test/after "$PgmStartPat" | test/before "$PgmEndPat" >${tmpdir}/runtest$$.3
 176
 177     for out_file in @PgmStdoutFile ; do
 178         $diff \$out_file ${tmpdir}/runtest$$.3 > ${tmpdir}/diffs$$
 179         if [ \$? -ne 0 ]; then
 180             echo $ToRun @PgmArgs \\< $PgmStdinFile
 181             echo expected stdout not matched by reality
 182             cat ${tmpdir}/diffs$$
 183             myexit=1
 184         fi
 185         /bin/rm -f ${tmpdir}/diffs$$
 186     done
 187 fi
 188 for out_file in @PgmStderrFile ; do
 189     $diff \$out_file ${tmpdir}/runtest$$.2 > ${tmpdir}/diffs$$
 190     if [ \$? -ne 0 ]; then
 191         echo $ToRun @PgmArgs \\< $PgmStdinFile
 192         echo expected stderr not matched by reality
 193         cat ${tmpdir}/diffs$$
 194         myexit=1
 195     fi
 196     /bin/rm -f ${tmpdir}/diffs$$
 197 done
 198 /bin/rm -f core $DefaultStdoutFile $DefaultStderrFile ${tmpdir}/runtest$$.1 ${tmpdir}/runtest$$.3 ${tmpdir}/runtest$$.2
 199 exit \$myexit
 200 EOSCRIPT
 201
 202 &run_something($Script);
 203 # print $Script if $Verbose;
 204 # open(SH, "| ${shell}") || die "Can't open shell pipe\n";
 205 # print SH $Script;
 206 # close(SH);
 207
 208 exit 0;
 209
 210 sub fromEnv {
 211     local($varname,$default) = @_;
 212     local($val) = $ENV{$varname};
 213     $val = $default if $val eq "";
 214     return $val;
 215 }
 216
 217 sub grab_arg_arg {
 218     local($option, $rest_of_arg) = @_;
 219
 220     if ($rest_of_arg) {
 221         return($rest_of_arg);
 222     } elsif ($#ARGV >= 0) {
 223         local($temp) = $ARGV[0]; shift(@ARGV);
 224         return($temp);
 225     } else {
 226         print STDERR "$Pgm: no argument following $option option\n";
 227         $Status++;
 228     }
 229 }
 230
 231 sub run_something {
 232     local($str_to_do) = @_;
 233
 234     print STDERR "$str_to_do\n" if $Verbose;
 235
 236     local($return_val) = 0;
 237
 238     # On Windows NT, we have to build a file before we can interpret it.
 239     local($scriptfile) = "./script$$";
 240     open(FOO,">$scriptfile") || die "Can't create script $scriptfile";
 241     print FOO $str_to_do;
 242     close FOO;
 243
 244     system("sh $scriptfile");
 245     $return_val = $?;
 246     system("rm $scriptfile");
 247
 248     if ($return_val != 0) {
 249 #ToDo: this return-value mangling is wrong
 250 #       local($die_msg) = "$Pgm: execution of the $tidy_name had trouble";
 251 #       $die_msg .= " (program not found)" if $return_val == 255;
 252 #       $die_msg .= " ($!)" if $Verbose && $! != 0;
 253 #       $die_msg .= "\n";
 254
 255         exit (($return_val == 0) ? 0 : 1);
 256     }
 257 }