diff options
author | Simon Marlow <simonmar@microsoft.com> | 2006-04-07 02:05:11 +0000 |
---|---|---|
committer | Simon Marlow <simonmar@microsoft.com> | 2006-04-07 02:05:11 +0000 |
commit | 0065d5ab628975892cea1ec7303f968c3338cbe1 (patch) | |
tree | 8e2afe0ab48ee33cf95009809d67c9649573ef92 /utils/runstdtest/runstdtest.prl | |
parent | 28a464a75e14cece5db40f2765a29348273ff2d2 (diff) | |
download | haskell-0065d5ab628975892cea1ec7303f968c3338cbe1.tar.gz |
Reorganisation of the source tree
Most of the other users of the fptools build system have migrated to
Cabal, and with the move to darcs we can now flatten the source tree
without losing history, so here goes.
The main change is that the ghc/ subdir is gone, and most of what it
contained is now at the top level. The build system now makes no
pretense at being multi-project, it is just the GHC build system.
No doubt this will break many things, and there will be a period of
instability while we fix the dependencies. A straightforward build
should work, but I haven't yet fixed binary/source distributions.
Changes to the Building Guide will follow, too.
Diffstat (limited to 'utils/runstdtest/runstdtest.prl')
-rw-r--r-- | utils/runstdtest/runstdtest.prl | 475 |
1 files changed, 475 insertions, 0 deletions
diff --git a/utils/runstdtest/runstdtest.prl b/utils/runstdtest/runstdtest.prl new file mode 100644 index 0000000000..1b1af9fb4d --- /dev/null +++ b/utils/runstdtest/runstdtest.prl @@ -0,0 +1,475 @@ +# +# The perl script requires the following variables to be bound +# to something meaningful before it will operate correctly: +# +# DEFAULT_TMPDIR +# CONTEXT_DIFF +# RM +# +# Given: +# * a program to run (1st arg) +# * some "command-line opts" ( -O<opt1> -O<opt2> ... ) +# [default: anything on the cmd line this script doesn't recognise ] +# the first opt not starting w/ "-" is taken to be an input +# file and (if it exists) is grepped for "what's going on here" +# comments (^-- !!!). +# * a file to feed to stdin ( -i<file> ) [default: /dev/null ] +# * a "time" command to use (-t <cmd>). +# +# * alternatively, a "-script <script>" argument says: run the +# named Bourne-shell script to do the test. It's passed the +# pgm-to-run as the one-and-only arg. +# +# Run the program with those options and that input, and check: +# if we get... +# +# * an expected exit status ( -x <val> ) [ default 0 ] +# * expected output on stdout ( -o1 <file> ) [ default /dev/null ] +# ( we'll accept one of several...) +# * expected output on stderr ( -o2 <file> ) [ default /dev/null ] +# ( we'll accept one of several...) +# +# (if the expected-output files' names end in .Z, then +# they are uncompressed before doing the comparison) +# +# (This is supposed to be a "prettier" replacement for runstdtest.) +# +# Flags +# ~~~~~ +# -accept-output replace output files with the ones actually generated by running +# the program +# +($Pgm = $0) =~ s|.*/||; +$Verbose = 0; +$SaveStderr = 0; +$SaveStdout = 0; +$Status = 0; +@PgmArgs = (); +$PgmFail=0; +$PgmExitStatus = 0; +$PgmStdinFile = '/dev/null'; +if ( $ENV{'TMPDIR'} ) { # where to make tmp file names + $TmpPrefix = $ENV{'TMPDIR'}; +} else { + $TmpPrefix ="$DEFAULT_TMPDIR"; + $ENV{'TMPDIR'} = "$DEFAULT_TMPDIR"; # set the env var as well +} +# If this is Cygwin, ignore eol and CR characters. +# Perhaps required for MSYS too, although the cygpath +# bit is hopefully unnecessary. +if ( `uname | grep CYGWIN` ) { + $CONTEXT_DIFF=$CONTEXT_DIFF . " --strip-trailing-cr" ; + $TmpPrefix = `cygpath -m $TmpPrefix | tr -d \\\\n`; +} +$ScriptFile = "$TmpPrefix/run_me$$"; +$DefaultStdoutFile = "$TmpPrefix/no_stdout$$"; # can't use /dev/null (e.g. Alphas) +$DefaultStderrFile = "$TmpPrefix/no_stderr$$"; +@PgmStdoutFile = (); +@PgmStderrFile = (); +$PreScript = ''; +$PostScript = ''; +$TimeCmd = ''; +$StatsFile = "$TmpPrefix/stats$$"; +$CachegrindStats = "cachegrind.out.summary"; +$SysSpecificTiming = ''; +$Cachegrind = 'no'; + +die "$Pgm: program to run not given as first argument\n" if $#ARGV < 0; +$ToRun = $ARGV[0]; shift(@ARGV); +# avoid picking up same-named thing from somewhere else on $PATH... +$ToRun = "./$ToRun" if -e "./$ToRun"; + +arg: while ($_ = $ARGV[0]) { + shift(@ARGV); + + /^--$/ && do { # let anything past after -- + push(@PgmArgs, @ARGV); + last arg; }; + + /^-v$/ && do { $Verbose = 1; next arg; }; + /^-accept-output-stderr$/ && do { $SaveStderr = 1; next arg; }; + /^-accept-output-stdout$/ && do { $SaveStdout = 1; next arg; }; + /^-accept-output$/ && do { $SaveStdout = 1; $SaveStderr = 1; next arg; }; + + /^-O(.*)/ && do { push(@PgmArgs, &grab_arg_arg('-O',$1)); next arg; }; + /^-i(.*)/ && do { $PgmStdinFile = &grab_arg_arg('-i',$1); + $Status++, + print STDERR "$Pgm: bogus -i input file: $PgmStdinFile\n" + if $PgmStdinFile !~ /^\/dev\/.*$/ && ! -f $PgmStdinFile; + next arg; }; + /^-fail/ && do { $PgmFail=1; next arg; }; + /^-x(.*)/ && do { $PgmExitStatus = &grab_arg_arg('-x',$1); + $Status++ , + print STDERR "$Pgm: bogus -x expected exit status: $PgmExitStatus\n" + if $PgmExitStatus !~ /^\d+$/; + next arg; }; + /^-o1(.*)/ && do { $out_file = &grab_arg_arg('-o1',$1); + push(@PgmStdoutFile, $out_file); + next arg; }; + /^-o2(.*)/ && do { $out_file = &grab_arg_arg('-o2',$1); + push(@PgmStderrFile, $out_file); + next arg; }; + /^-prescript(.*)/ && do { $PreScript = &grab_arg_arg('-prescript',$1); + next arg; }; + /^-postscript(.*)/ && do { $PostScript = &grab_arg_arg('-postscript',$1); + next arg; }; + /^-script/ && do { print STDERR "$Pgm: -script argument is obsolete;\nUse -prescript and -postscript instead.\n"; + $Status++; + next arg; }; + /^-(ghc|hbc)-timing$/ && do { $SysSpecificTiming = $1; + next arg; }; + /^-cachegrind$/ && do { $SysSpecificTiming = 'ghc-instrs'; + $Cachegrind = 'yes'; + next arg }; + /^-t(.*)/ && do { $TimeCmd = &grab_arg_arg('-t', $1); next arg; }; + + # anything else is taken to be a pgm arg + push(@PgmArgs, $_); +} + +foreach $out_file ( @PgmStdoutFile ) { + if ( ! -f $out_file && !$SaveStdout ) { + print STDERR "$Pgm: warning: expected-stdout file missing: $out_file\n"; + pop(@PgmStdoutFile); + } +} + +foreach $out_file ( @PgmStderrFile ) { + if ( ! -f $out_file && !$SaveStderr ) { + print STDERR "$Pgm: warning: expected-stderr file missing: $out_file\n"; + pop(@PgmStderrFile); + } +} + +exit 1 if $Status; + +# add on defaults if none specified +@PgmStdoutFile = ( $DefaultStdoutFile ) if $#PgmStdoutFile < 0; +@PgmStderrFile = ( $DefaultStderrFile ) if $#PgmStderrFile < 0; + +# tidy up the pgm args: +# (1) look for the "first input file" +# and grep it for "interesting" comments (-- !!! ) +# (2) quote any args w/ whitespace in them. +$grep_done = 0; +foreach $a ( @PgmArgs ) { + if (! $grep_done && $a !~ /^-/ && -f $a) { + print `egrep "^--[ ]?!!!" $a`; + $grep_done = 1; + } + if ($a =~ /\s/ || $a =~ /'/) { + $a =~ s/'/\\'/g; # backslash the quotes; + $a = "\"$a\""; # quote the arg + } +} + +# deal with system-specific timing options +$TimingMagic = ''; +if ( $SysSpecificTiming =~ /^ghc/ ) { + $TimingMagic = "+RTS -S$StatsFile -RTS" +} elsif ( $SysSpecificTiming eq 'hbc' ) { + $TimingMagic = "-S$StatsFile"; +} + +if ($PreScript ne '') { + local($to_do); + $PreScriptLines = `cat $PreScript`; + $PreScriptLines =~ s/\r//g; +} else { + $PreScriptLines = ''; +} + +if ($PostScript ne '') { + local($to_do); + $PostScriptLines = `cat $PostScript`; + $PostScriptLines =~ s/\r//g; + $* = 1; + $PostScriptLines =~ s#\$o1#$TmpPrefix/runtest$$.1#g; + $PostScriptLines =~ s#\$o2#$TmpPrefix/runtest$$.2#g; +} else { + $PostScriptLines = ''; +} + +# OK, so we're gonna do the normal thing... + +if ($Cachegrind eq 'yes') { + $CachegrindPrefix = "valgrind --tool=cachegrind --log-fd=9 9>$CachegrindStats"; +} else { + $CachegrindPrefix = ''; +} + +$Script = <<EOSCRIPT; +#! /bin/sh +myexit=0 +diffsShown=0 +rm -f $DefaultStdoutFile $DefaultStderrFile +cat /dev/null > $DefaultStdoutFile +cat /dev/null > $DefaultStderrFile +$PreScriptLines +$SpixifyLine1 +echo $TimeCmd /bin/sh -c \'$CachegrindPrefix $ToRun $TimingMagic @PgmArgs < $PgmStdinFile 1> $TmpPrefix/runtest$$.1 2> $TmpPrefix/runtest$$.2 3> $TmpPrefix/runtest$$.3\' +$TimeCmd /bin/sh -c \'$CachegrindPrefix $ToRun $TimingMagic @PgmArgs < $PgmStdinFile 1> $TmpPrefix/runtest$$.1 2> $TmpPrefix/runtest$$.2 3> $TmpPrefix/runtest$$.3\' +progexit=\$? +if [ \$progexit -eq 0 ] && [ $PgmFail -ne 0 ]; then + echo $ToRun @PgmArgs \\< $PgmStdinFile + echo "****" expected a failure, but was successful + myexit=1 +fi +if [ \$progexit -ne $PgmExitStatus ] && [ $PgmFail -eq 0 ]; then + echo $ToRun @PgmArgs \\< $PgmStdinFile + echo "****" expected exit status $PgmExitStatus not seen \\; got \$progexit + myexit=1 +else + $PostScriptLines + hit='NO' + for out_file in @PgmStdoutFile ; do + if cmp -s \$out_file $TmpPrefix/runtest$$.1 ; then + hit='YES' + fi + done + if [ \$hit = 'NO' ] ; then + echo $ToRun @PgmArgs \\< $PgmStdinFile + echo expected stdout not matched by reality + orig_file="$PgmStdoutFile[0]"; + [ ! -f \$orig_file ] && orig_file="/dev/null" + ${CONTEXT_DIFF} \$orig_file $TmpPrefix/runtest$$.1 + myexit=\$? + diffsShown=1 + fi + if [ $SaveStdout = 1 ] && + [ $PgmStdoutFile[0] != $DefaultStdoutFile ] && [ -s $TmpPrefix/runtest$$.1 ]; then + echo Saving away stdout output in $PgmStdoutFile[0] ... + if [ -f $PgmStdoutFile[0] ]; then + rm -f $PgmStdoutFile[0].bak + cp $PgmStdoutFile[0] $PgmStdoutFile[0].bak + fi; + cp $TmpPrefix/runtest$$.1 $PgmStdoutFile[0] + fi +fi + +hit='NO' +for out_file in @PgmStderrFile ; do + if cmp -s \$out_file $TmpPrefix/runtest$$.2 ; then + hit='YES' + fi +done +if [ \$hit = 'NO' ] ; then + echo $ToRun @PgmArgs \\< $PgmStdinFile + echo expected stderr not matched by reality + orig_file="$PgmStderrFile[0]" + [ ! -f \$orig_file ] && orig_file="/dev/null" + ${CONTEXT_DIFF} \$orig_file $TmpPrefix/runtest$$.2 + myexit=\$? + diffsShown=1 +fi +if [ $SaveStderr = 1 ] && + [ $PgmStderrFile[0] != $DefaultStderrFile ] && [ -s $TmpPrefix/runtest$$.2 ]; then + echo Saving away stderr output in $PgmStderrFile[0] ... + if [ -f $PgmStderrFile[0] ]; then + rm -f $PgmStderrFile[0].bak + cp $PgmStderrFile[0] $PgmStderrFile[0].bak + fi; + cp $TmpPrefix/runtest$$.2 $PgmStderrFile[0] +fi + +${RM} core $ToRunOrig.spix $DefaultStdoutFile $DefaultStderrFile $TmpPrefix/runtest$$.1 $TmpPrefix/runtest$$.2 $TmpPrefix/runtest$$.3 +exit \$myexit +EOSCRIPT + +# bung script into a file +open(SCR, "> $ScriptFile") || die "Failed opening script file $ScriptFile!\n"; +print SCR $Script; +close(SCR) || die "Failed closing script file!\n"; +chmod 0755, $ScriptFile; + +print STDERR $Script if $Verbose; + +&run_something($ScriptFile); + +if ( $SysSpecificTiming eq '' ) { + unlink $StatsFile; + unlink $ScriptFile; + exit 0; +} + +&process_stats_file(); +&process_cachegrind_files() if $Cachegrind eq 'yes'; + +# print out what we found +print STDERR "<<$SysSpecificTiming: "; +if ( $Cachegrind ne 'yes') { + print STDERR "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $GCWork bytes GC work, ${TotMem}M in use, $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)"; +} else { + print STDERR "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $GCWork bytes GC work, ${TotMem}M in use, $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed), $TotInstrs instructions, $TotReads memory reads, $TotWrites memory writes, $TotMisses L2 cache misses"; +}; +print STDERR " :$SysSpecificTiming>>\n"; + +# OK, party over +unlink $StatsFile; +unlink $ScriptFile; +exit 0; + +sub grab_arg_arg { + local($option, $rest_of_arg) = @_; + + if ($rest_of_arg ne "") { + return($rest_of_arg); + } elsif ($#ARGV >= 0) { + local($temp) = $ARGV[0]; shift(@ARGV); + return($temp); + } else { + print STDERR "$Pgm: no argument following $option option\n"; + $Status++; + } +} + +sub run_something { + local($str_to_do) = @_; + +# print STDERR "$str_to_do\n" if $Verbose; + + local($return_val) = 0; + system($str_to_do); + $return_val = $?; + + if ($return_val != 0) { +#ToDo: this return-value mangling is wrong +# local($die_msg) = "$Pgm: execution of the $tidy_name had trouble"; +# $die_msg .= " (program not found)" if $return_val == 255; +# $die_msg .= " ($!)" if $Verbose && $! != 0; +# $die_msg .= "\n"; + unlink $ScriptFile; + unlink $StatsFile; + + exit (($return_val == 0) ? 0 : 1); + } +} + +sub process_stats_file { + + # OK, process system-specific stats file + if ( $SysSpecificTiming =~ /^ghc/ ) { + + #NB: nearly the same as in GHC driver's -ghc-timing stuff + + open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n"; + + local($max_live) = 0; + local($tot_live) = 0; # for calculating residency stuff + local($tot_samples) = 0; + + $GCWork = 0; + while (<STATS>) { + if (! /Gen:\s+0/ && /^\s*\d+\s+\d+\s+(\d+)\s+\d+\.\d+/ ) { + $max_live = $1 if $max_live < $1; + $tot_live += $1; + $tot_samples += 1; + } + + $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/; + $GCWork += $1 if /^\s*([0-9,]+) bytes copied during GC/; + +# if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) { +# $MaxResidency = $1; $ResidencySamples = $2; +# } + + $GCs = $1 if /^\s*([0-9,]+) collections? in generation 0/; + + if ( /^\s+([0-9]+)\s+Mb total memory/ ) { + $TotMem = $1; + } + + if ( /^\s*INIT\s+time\s*(-*\d+\.\d\d)s\s*\(\s*(-*\d+\.\d\d)s elapsed\)/ ) { + $InitTime = $1; $InitElapsed = $2; + } elsif ( /^\s*MUT\s+time\s*(-*\d+\.\d\d)s\s*\(\s*(-*\d+\.\d\d)s elapsed\)/ ) { + $MutTime = $1; $MutElapsed = $2; + } elsif ( /^\s*GC\s+time\s*(-*\d+\.\d\d)s\s*\(\s*(-*\d+\.\d\d)s elapsed\)/ ) { + $GcTime = $1; $GcElapsed = $2; + } + } + close(STATS) || die "Failed when closing $StatsFile\n"; + if ( $tot_samples > 0 ) { + $ResidencySamples = $tot_samples; + $MaxResidency = $max_live; + $AvgResidency = int ($tot_live / $tot_samples) ; + } + + } elsif ( $SysSpecificTiming eq 'hbc' ) { + + open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n"; + while (<STATS>) { + $BytesAlloc = $1 if /^\s*([0-9]+) bytes allocated from the heap/; + + $GCs = $1 if /^\s*([0-9]+) GCs?,$/; + + if ( /^\s*(\d+\.\d\d) \((\d+\.\d)\) seconds total time,$/ ) { + $MutTime = $1; $MutElapsed = $2; # will fix up later + + $InitTime = 0; $InitElapsed = 0; # hbc doesn't report these + + } elsif ( /^\s*(\d+\.\d\d) \((\d+\.\d)\) seconds GC time/ ) { + $GcTime = $1; $GcElapsed = $2; + + # fix up mutator time now + $MutTime = sprintf("%.2f", ($MutTime - $GcTime)); + $MutElapsed = sprintf("%.1f", ($MutElapsed - $GcElapsed)); + } + } + close(STATS) || die "Failed when closing $StatsFile\n"; + } + + # warn about what we didn't find + print STDERR "Warning: BytesAlloc not found in stats file\n" unless defined($BytesAlloc); + print STDERR "Warning: GCs not found in stats file\n" unless defined($GCs); + print STDERR "Warning: InitTime not found in stats file\n" unless defined($InitTime); + print STDERR "Warning: InitElapsed not found in stats file\n" unless defined($InitElapsed); + print STDERR "Warning: MutTime not found in stats file\n" unless defined($MutTime); + print STDERR "Warning: MutElapsed not found in stats file\n" unless defined($MutElapsed); + print STDERR "Warning: GcTime inot found in stats file\n" unless defined($GcTime); + print STDERR "Warning: GcElapsed not found in stats file\n" unless defined($GcElapsed); + print STDERR "Warning: total memory not found in stats file\n" unless defined($TotMem); + print STDERR "Warning: GC work not found in stats file\n" unless defined($GCWork); + + # things we didn't necessarily expect to find + $MaxResidency = 0 unless defined($MaxResidency); + $AvgResidency = 0 unless defined($AvgResidency); + $ResidencySamples = 0 unless defined($ResidencySamples); + + # a bit of tidying + $BytesAlloc =~ s/,//g; + $GCWork =~ s/,//g; + $MaxResidency =~ s/,//g; + $GCs =~ s/,//g; + $InitTime =~ s/,//g; + $InitElapsed =~ s/,//g; + $MutTime =~ s/,//g; + $MutElapsed =~ s/,//g; + $GcTime =~ s/,//g; + $GcElapsed =~ s/,//g; +} + +sub process_cachegrind_files { + + open(STATS, "< $CachegrindStats") || die("Can't open $CachegrindStats\n"); + + while (<STATS>) { + /^==\d+==\s+I\s+refs:\s+([0-9,]*)/ && do { + $TotInstrs = $1; + $TotInstrs =~ s/,//g; + }; + + /^==\d+==\s+D\s+refs:\s+[0-9,]+\s+\(([0-9,]+)\s+rd\s+\+\s+([0-9,]+)\s+wr/ && do { + $TotReads = $1; + $TotWrites = $2; + $TotReads =~ s/,//g; + $TotWrites =~ s/,//g; + }; + + /^==\d+==\s+L2d\s+misses:\s+([0-9,]+)/ && do { + $TotMisses = $1; + $TotMisses =~ s/,//g; + }; + } + close(STATS); +} + |