glafp-utils/scripts/runstdtest.prl

   1 #! /usr/local/bin/perl
   2 #
   3 # Given:
   4 #       * a program to run (1st arg)
   5 #       * some "command-line opts" ( -O<opt1> -O<opt2> ... )
   6 #           [default: anything on the cmd line this script doesn't recognise ]
   7 #         the first opt not starting w/ "-" is taken to be an input
   8 #         file and (if it exists) is grepped for "what's going on here"
   9 #         comments (^--!!!).
  10 #       * a file to feed to stdin ( -i<file> ) [default: /dev/null ]
  11 #       * a "time" command to use (-t <cmd>).
  12 #
  13 #       * alternatively, a "-script <script>" argument says: run the
  14 #         named Bourne-shell script to do the test.  It's passed the
  15 #         pgm-to-run as the one-and-only arg.
  16 #
  17 # Run the program with those options and that input, and check:
  18 # if we get...
  19 #
  20 #       * an expected exit status ( -x <val> ) [ default 0 ]
  21 #       * expected output on stdout ( -o1 <file> ) [ default /dev/null ]
  22 #               ( we'll accept one of several...)
  23 #       * expected output on stderr ( -o2 <file> ) [ default /dev/null ]
  24 #               ( we'll accept one of several...)
  25 #
  26 #       (if the expected-output files' names end in .Z, then
  27 #        they are uncompressed before doing the comparison)
  28 #
  29 # (This is supposed to be a "prettier" replacement for runstdtest.)
  30 #
  31 ($Pgm = $0) =~ s|.*/||;
  32 $Verbose = 0;
  33 $Status = 0;
  34 @PgmArgs = ();
  35 $PgmExitStatus = 0;
  36 $PgmStdinFile  = '/dev/null';
  37 $TmpPrefix = '$(TMPDIR)';
  38 $ScriptFile = "$TmpPrefix/run_me$$";
  39 $DefaultStdoutFile = "$TmpPrefix/no_stdout$$"; # can't use /dev/null (e.g. Alphas)
  40 $DefaultStderrFile = "$TmpPrefix/no_stderr$$";
  41 @PgmStdoutFile = ();
  42 @PgmStderrFile = ();
  43 $AltScript = '';
  44 $TimeCmd = '';
  45 $StatsFile = "$TmpPrefix/stats$$";
  46 $SysSpecificTiming = '';
  47 $SpixTiming = 'no';
  48
  49 die "$Pgm: program to run not given as first argument\n" if $#ARGV < 0;
  50 $ToRun = $ARGV[0]; shift(@ARGV);
  51 # avoid picking up same-named thing from somewhere else on $PATH...
  52 $ToRun = "./$ToRun" if $ToRun !~ /^\//;
  53
  54 arg: while ($_ = $ARGV[0]) {
  55     shift(@ARGV);
  56
  57     /^-v$/      && do { $Verbose = 1; next arg; };
  58     /^-O(.*)/   && do { push(@PgmArgs, &grab_arg_arg('-O',$1)); next arg; };
  59     /^-i(.*)/   && do { $PgmStdinFile = &grab_arg_arg('-i',$1);
  60                         $Status++,
  61                         print STDERR "$Pgm: bogus -i input file: $PgmStdinFile\n"
  62                             if ! -f $PgmStdinFile;
  63                         next arg; };
  64     /^-x(.*)/   && do { $PgmExitStatus = &grab_arg_arg('-x',$1);
  65                         $Status++ ,
  66                         print STDERR "$Pgm: bogus -x expected exit status: $PgmExitStatus\n"
  67                             if $PgmExitStatus !~ /^\d+$/;
  68                         next arg; };
  69     /^-o1(.*)/  && do { $out_file = &grab_arg_arg('-o1',$1);
  70                         push(@PgmStdoutFile, $out_file);
  71                         next arg; };
  72     /^-o2(.*)/  && do { $out_file = &grab_arg_arg('-o2',$1);
  73                         push(@PgmStderrFile, $out_file);
  74                         next arg; };
  75     /^-script(.*)/ && do { $AltScript = &grab_arg_arg('-script',$1);
  76                            @PgmStdoutFile = (); # re-init
  77                            @PgmStderrFile = (); # ditto
  78                            next arg; };
  79     /^-(ghc|hbc)-timing$/ && do { $SysSpecificTiming = $1;
  80                                   next arg; };
  81     /^-spix-timing$/ && do { $SysSpecificTiming = 'ghcspix';
  82                              $SpixTiming = 'yes';
  83                              next arg; };
  84     /^-t(.*)/   && do { $TimeCmd = &grab_arg_arg('-t', $1); next arg; };
  85
  86     # anything else is taken to be a pgm arg
  87     push(@PgmArgs, $_);
  88 }
  89
  90 foreach $out_file ( @PgmStdoutFile ) {
  91     $Status++ ,
  92     print STDERR "$Pgm: bogus -o1 expected-output file: $out_file\n"
  93         if ! -f $out_file;
  94 }
  95
  96 foreach $out_file ( @PgmStderrFile ) {
  97     $Status++,
  98     print STDERR "$Pgm: bogus -o2 expected-stderr file: $out_file\n"
  99         if ! -f $out_file;
 100 }
 101
 102 exit 1 if $Status;
 103
 104 # add on defaults if none specified
 105 @PgmStdoutFile = ( $DefaultStdoutFile ) if $#PgmStdoutFile < 0;
 106 @PgmStderrFile = ( $DefaultStderrFile ) if $#PgmStderrFile < 0;
 107
 108 # tidy up the pgm args:
 109 # (1) look for the "first input file"
 110 #     and grep it for "interesting" comments (--!!! )
 111 # (2) quote any args w/ whitespace in them.
 112 $grep_done = 0;
 113 foreach $a ( @PgmArgs ) {
 114     if (! $grep_done && $a !~ /^-/ && -f $a) {
 115         print `egrep "^--!!!" $a`;
 116         $grep_done = 1;
 117     }
 118     if ($a =~ /\s/ || $a =~ /'/) {
 119         $a =~ s/'/\\'/g;    # backslash the quotes;
 120         $a = "\"$a\"";      # quote the arg
 121     }
 122 }
 123
 124 # deal with system-specific timing options
 125 $TimingMagic = '';
 126 if ( $SysSpecificTiming =~ /^ghc/ ) {
 127     $TimingMagic = "+RTS -s$StatsFile -RTS"
 128 } elsif ( $SysSpecificTiming eq 'hbc' ) {
 129     $TimingMagic = "-S$StatsFile";
 130 }
 131
 132 if ($AltScript ne '') {
 133     local($to_do);
 134     $to_do = `cat $AltScript`;
 135     # glue in pgm to run...
 136     $* = 1;
 137     $to_do =~ s/^\$1 /$ToRun /;
 138     &run_something($to_do);
 139     exit 0;
 140 #    exec "$AltScript $ToRun";
 141 #    print STDERR "Failed to exec!!! $AltScript $ToRun\n";
 142 #    exit 1;
 143 }
 144
 145 $ToRunOrig = $ToRun;
 146 if ( $SpixTiming eq 'yes' ) {
 147     $ToRun .= '.spix';
 148
 149     # gotta find first/last addresses in the mutator code
 150     $FirstSpix = '_callWrapper';
 151     $LastSpix  = '???'; # usually _mpz_get_si, but can't be sure
 152
 153     open(SPIXNM, "nm -n $ToRunOrig |") || die "nm -n $ToRunOrig open failed!\n";
 154     spix: while (<SPIXNM>) {
 155         if ( / T (_FreeMallocPtr|_([A-Za-z]+)Hook|_xmalloc|_mpz_get_si)$/ ) {
 156             $LastSpix = $1;
 157             last spix;
 158         }
 159     }
 160     close(SPIXNM); # || die "nm -n $ToRunOrig close failed!\n";
 161
 162     $SpixifyLine = "spix -o $ToRun -t$FirstSpix,$LastSpix $ToRunOrig";
 163     $SpixstatsLine = "spixstats -b $TmpPrefix/runtest$$.3 $ToRunOrig > $ToRunOrig.spixstats";
 164 } else {
 165     $SpixifyLine = '';
 166     $SpixstatsLine = '';
 167 }
 168
 169 # OK, so we're gonna do the normal thing...
 170
 171 $Script = <<EOSCRIPT;
 172 #! /bin/sh
 173 myexit=0
 174 diffsShown=0
 175 rm -f $DefaultStdoutFile $DefaultStderrFile
 176 cat /dev/null > $DefaultStdoutFile
 177 cat /dev/null > $DefaultStderrFile
 178 $SpixifyLine
 179 $TimeCmd /bin/sh -c \'$ToRun $TimingMagic @PgmArgs < $PgmStdinFile 1> $TmpPrefix/runtest$$.1 2> $TmpPrefix/runtest$$.2 3> $TmpPrefix/runtest$$.3\'
 180 progexit=\$?
 181 if [ \$progexit -ne $PgmExitStatus ]; then
 182     echo $ToRun @PgmArgs \\< $PgmStdinFile
 183     echo expected exit status $PgmExitStatus not seen \\; got \$progexit
 184     myexit=1
 185 else
 186     hit='NO'
 187     for out_file in @PgmStdoutFile ; do
 188         if cmp -s \$out_file $TmpPrefix/runtest$$.1 ; then
 189             hit='YES'
 190         fi
 191     done
 192     if [ \$hit = 'NO' ] ; then
 193         echo $ToRun @PgmArgs \\< $PgmStdinFile
 194         echo expected stdout not matched by reality
 195         $(CONTEXT_DIFF) $PgmStdoutFile[0] $TmpPrefix/runtest$$.1
 196         myexit=1
 197         diffsShown=1
 198     fi
 199 fi
 200 egrep -v '^ld\.so:.*has older revision than expected' < $TmpPrefix/runtest$$.2 > $TmpPrefix/runtest$$.2b
 201 mv -f $TmpPrefix/runtest$$.2b $TmpPrefix/runtest$$.2
 202
 203 hit='NO'
 204 for out_file in @PgmStderrFile ; do
 205     if cmp -s \$out_file $TmpPrefix/runtest$$.2 ; then
 206         hit='YES'
 207     fi
 208 done
 209 if [ \$hit = 'NO' ] ; then
 210     echo $ToRun @PgmArgs \\< $PgmStdinFile
 211     echo expected stderr not matched by reality
 212     $(CONTEXT_DIFF) $PgmStderrFile[0] $TmpPrefix/runtest$$.2
 213     myexit=1
 214     diffsShown=1
 215 fi
 216 $SpixstatsLine
 217 $(RM) core $ToRunOrig.spix $DefaultStdoutFile $DefaultStderrFile $TmpPrefix/runtest$$.1 $TmpPrefix/runtest$$.2 $TmpPrefix/runtest$$.3
 218 exit \$myexit
 219 EOSCRIPT
 220
 221 # bung script into a file
 222 open(SCR, "> $ScriptFile") || die "Failed opening script file $ScriptFile!\n";
 223 print SCR $Script;
 224 close(SCR) || die "Failed closing script file!\n";
 225 chmod 0755, $ScriptFile;
 226
 227 print STDERR $Script if $Verbose;
 228
 229 &run_something($ScriptFile);
 230
 231 if ( $SysSpecificTiming eq '' ) {
 232     unlink $StatsFile;
 233     unlink $ScriptFile;
 234     exit 0;
 235 }
 236
 237 &process_stats_file();
 238 &process_spixstats_file() if $SpixTiming eq 'yes';
 239
 240 # print out what we found
 241 if ( $SpixTiming ne 'yes' ) {
 242     print STDERR "<<$SysSpecificTiming: ",
 243         "$BytesAlloc bytes, $GCs GCs, $MaxResidency bytes residency ($ResidencySamples samples), $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)",
 244         " :$SysSpecificTiming>>\n";
 245 } else {
 246     print STDERR "<<$SysSpecificTiming: ",
 247         "$BytesAlloc bytes, $GCs GCs, $MaxResidency bytes residency ($ResidencySamples samples), $TotalInsns instructions, $LoadInsns loads, $StoreInsns stores, $BranchInsns branches, $OtherInsns others",
 248         " :$SysSpecificTiming>>\n";
 249 }
 250
 251 # OK, party over
 252 unlink $StatsFile;
 253 unlink $ScriptFile;
 254 exit 0;
 255
 256 sub grab_arg_arg {
 257     local($option, $rest_of_arg) = @_;
 258
 259     if ($rest_of_arg) {
 260         return($rest_of_arg);
 261     } elsif ($#ARGV >= 0) {
 262         local($temp) = $ARGV[0]; shift(@ARGV);
 263         return($temp);
 264     } else {
 265         print STDERR "$Pgm: no argument following $option option\n";
 266         $Status++;
 267     }
 268 }
 269
 270 sub run_something {
 271     local($str_to_do) = @_;
 272
 273 #   print STDERR "$str_to_do\n" if $Verbose;
 274
 275     local($return_val) = 0;
 276     system($str_to_do);
 277     $return_val = $?;
 278
 279     if ($return_val != 0) {
 280 #ToDo: this return-value mangling is wrong
 281 #       local($die_msg) = "$Pgm: execution of the $tidy_name had trouble";
 282 #       $die_msg .= " (program not found)" if $return_val == 255;
 283 #       $die_msg .= " ($!)" if $Verbose && $! != 0;
 284 #       $die_msg .= "\n";
 285         unlink $ScriptFile;
 286         unlink $StatsFile;
 287
 288         exit (($return_val == 0) ? 0 : 1);
 289     }
 290 }
 291
 292 sub process_stats_file {
 293
 294     # OK, process system-specific stats file
 295     if ( $SysSpecificTiming =~ /^ghc/ ) {
 296
 297         #NB: nearly the same as in GHC driver's -ghc-timing stuff
 298
 299         open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n";
 300         while (<STATS>) {
 301             $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/;
 302
 303             if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) {
 304                 $MaxResidency = $1; $ResidencySamples = $2;
 305             }
 306
 307             $GCs = $1 if /^\s*([0-9,]+) garbage collections? performed/;
 308
 309             if ( /^\s*INIT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
 310                 $InitTime = $1; $InitElapsed = $2;
 311             } elsif ( /^\s*MUT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
 312                 $MutTime = $1; $MutElapsed = $2;
 313             } elsif ( /^\s*GC\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
 314                 $GcTime = $1; $GcElapsed = $2;
 315             }
 316         }
 317         close(STATS) || die "Failed when closing $StatsFile\n";
 318
 319     } elsif ( $SysSpecificTiming eq 'hbc' ) {
 320
 321         open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n";
 322         while (<STATS>) {
 323             $BytesAlloc = $1 if /^\s*([0-9]+) bytes allocated from the heap/;
 324
 325             $GCs = $1 if /^\s*([0-9]+) GCs?,$/;
 326
 327             if ( /^\s*(\d+\.\d\d) \((\d+\.\d)\) seconds total time,$/ ) {
 328                 $MutTime = $1; $MutElapsed = $2; # will fix up later
 329
 330                 $InitTime = 0; $InitElapsed = 0; # hbc doesn't report these
 331
 332             } elsif ( /^\s*(\d+\.\d\d) \((\d+\.\d)\) seconds GC time/ ) {
 333                 $GcTime = $1; $GcElapsed = $2;
 334
 335                 # fix up mutator time now
 336                 $MutTime    = sprintf("%.2f", ($MutTime    - $GcTime));
 337                 $MutElapsed = sprintf("%.1f", ($MutElapsed - $GcElapsed));
 338             }
 339         }
 340         close(STATS) || die "Failed when closing $StatsFile\n";
 341     }
 342
 343     # warn about what we didn't find
 344     print STDERR "Warning: BytesAlloc not found in stats file\n" unless defined($BytesAlloc);
 345     print STDERR "Warning: GCs not found in stats file\n" unless defined($GCs);
 346     print STDERR "Warning: InitTime not found in stats file\n" unless defined($InitTime);
 347     print STDERR "Warning: InitElapsed not found in stats file\n" unless defined($InitElapsed);
 348     print STDERR "Warning: MutTime not found in stats file\n" unless defined($MutTime);
 349     print STDERR "Warning: MutElapsed not found in stats file\n" unless defined($MutElapsed);
 350     print STDERR "Warning: GcTime inot found in stats file\n" unless defined($GcTime);
 351     print STDERR "Warning: GcElapsed not found in stats file\n" unless defined($GcElapsed);
 352
 353     # things we didn't necessarily expect to find
 354     $MaxResidency     = 0 unless defined($MaxResidency);
 355     $ResidencySamples = 0 unless defined($ResidencySamples);
 356
 357     # a bit of tidying
 358     $BytesAlloc =~ s/,//g;
 359     $MaxResidency =~ s/,//g;
 360     $GCs =~ s/,//g;
 361     $InitTime =~ s/,//g;
 362     $InitElapsed =~ s/,//g;
 363     $MutTime =~ s/,//g;
 364     $MutElapsed =~ s/,//g;
 365     $GcTime =~ s/,//g;
 366     $GcElapsed =~ s/,//g;
 367 }
 368
 369 sub process_spixstats_file {
 370
 371     $TotalInsns = 0;
 372     $LoadInsns  = 0;
 373     $StoreInsns = 0;
 374     $BranchInsns= 0;
 375     $OtherInsns = 0;
 376
 377     open(STATS, "< $ToRunOrig.spixstats") || die "Failed when opening $ToRunOrig.spixstats\n";
 378     while (<STATS>) {
 379         last if /^OPCODES \(STATIC\):/; # party over
 380
 381         next if /^OPCODES \(DYNAMIC\):/;
 382         next if /^$/;
 383         next if /^opcode\s+#executed/;
 384         next if /^SUBTOTAL/;
 385
 386         if ( /^ld\S*\s+(\d+)/ ) {
 387             $LoadInsns += $1;
 388
 389         } elsif ( /^st\S*\s+(\d+)/ ) {
 390             $StoreInsns += $1;
 391
 392         } elsif ( /^(jmpl|call|b\S*)\s+(\d+)/ ) {
 393             $BranchInsns += $2;
 394
 395         } elsif ( /^TOTAL\s+(\d+)/ ) {
 396             $TotalInsns = $1;
 397             print STDERR "TotalInsns doesn't match categories total!\n"
 398                 if $TotalInsns !=
 399                    ($LoadInsns + $StoreInsns + $BranchInsns + $OtherInsns);
 400
 401         } elsif ( /^\S+\s+(\d+)/ ) {
 402             $OtherInsns += $1;
 403
 404         } else {
 405             die "Funny line?? $_";
 406         }
 407     }
 408     close(STATS) || die "Failed when closing $ToRunOrig.spixstats\n";
 409 }