xargs/testsuite/config/unix.exp

   1 # -*- TCL -*-
   2 # Test-specific TCL procedures required by DejaGNU.
   3 # Copyright (C) 1994, 2005, 2007, 2010, 2011 Free Software Foundation,
   4 # Inc.
   5 #
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 # Modified by David MacKenzie <djm@gnu.ai.mit.edu> from the gcc files
  20 # written by Rob Savoye <rob@cygnus.com>.
  21 \f
  22
  23 verbose "base_dir is $base_dir" 2
  24
  25 set objfile "xargs.o"
  26 set dir "$base_dir/.."
  27 set path "$dir/$objfile"
  28 if ![file exists $path] then {
  29     error "$path does not exist"
  30 } else {
  31     set XARGS [findfile $base_dir/../xargs [transform xargs]]
  32 }
  33
  34 global XARGS
  35
  36
  37 set XARGS [findfile $base_dir/../xargs $base_dir/../xargs [transform xargs]]
  38 if [ string match "/*" $XARGS ] {
  39     verbose "XARGS is set to $XARGS" 1
  40 } else {
  41     error "Failed to find a binary to test"
  42 }
  43
  44 global XARGSFLAGS
  45 if ![info exists XARGSFLAGS] then {
  46     set XARGSFLAGS ""
  47 }
  48
  49 # Called by runtest.
  50 # Extract and print the version number of xargs.
  51 proc xargs_version {} {
  52     global XARGS
  53     global XARGSFLAGS
  54
  55     if {[which $XARGS] != 0} then {
  56         set tmp [ eval exec $XARGS $XARGSFLAGS --version </dev/null | sed 1q ]
  57         clone_output $tmp
  58     } else {
  59         warning "$XARGS, program does not exist"
  60     }
  61 }
  62
  63 # Run xargs and leave the output in $comp_output.
  64 # Called by individual test scripts.
  65 proc xargs_start { passfail options {infile ""} {errh ""} {command ""} } {
  66     global verbose
  67     global XARGS
  68     global XARGSFLAGS
  69     global comp_output
  70
  71     if {[which $XARGS] == 0} then {
  72         error "$XARGS, program does not exist"
  73         exit 1
  74     }
  75
  76     set scriptname [uplevel {info script}]
  77     set testbase [file rootname $scriptname]
  78     set testname [file tail $testbase]
  79
  80     if {[string match "\[0-9\]*" $passfail]} then {
  81         set execrc "$passfail"
  82     } elseif {[string match "p*" $passfail]} then {
  83         set execrc "0"
  84     } elseif {[string match "f*" $passfail]} then {
  85         set execrc "1"
  86     } else {
  87         fail "$testname, failure in testing framework: passfail=$passfail"
  88         return
  89     }
  90
  91     set outfile "$testbase.xo"
  92     if {$infile != ""} then {
  93         set infile "[file dirname [file dirname $testbase]]/inputs/$infile"
  94     } else {
  95         set infile /dev/null
  96     }
  97
  98     if {[string match "s*" $errh]} then {
  99         set errfile ""
 100     } else {
 101         set errfile "$testbase.xe"
 102     }
 103
 104     catch "exec rm -f xargs.out xargs.err"
 105
 106     if {$command != ""} then {
 107         set cmd "$command  < $infile > xargs.out 2> xargs.err"
 108     } else {
 109         set cmd "$XARGS $XARGSFLAGS $options < $infile > xargs.out 2> xargs.err"
 110     }
 111     send_log "$cmd\n"
 112     if $verbose>1 then {
 113         send_user "Spawning \"$cmd\"\n"
 114     }
 115
 116     set status 0
 117     if {[catch "exec $cmd" comp_output]} then {
 118         if {[lindex $::errorCode 0] == "CHILDSTATUS"} then {
 119             set status [lindex $::errorCode 2]
 120         } else {
 121             fail "$testname, failure in testing framework, $comp_output"
 122             return
 123         }
 124     }
 125
 126     catch "exec cat xargs.err" comp_error
 127
 128     if {$execrc != $status} then {
 129         if {$status == 0} then {
 130             fail "$testname, unexpected success"
 131         } elseif {$execrc == 0} then {
 132             fail "$testname, unexpected failure, $comp_output, $comp_error"
 133         } else {
 134             fail "$testname, expected exit code $execrc, but got exit code $status"
 135         }
 136         return
 137     }
 138     # ok, at least exit code match.
 139
 140     if [file exists $outfile] then {
 141         set cmp_cmd "cmp xargs.out $outfile"
 142         send_log "$cmp_cmd\n"
 143         catch "exec $cmp_cmd" cmpout
 144         if {$cmpout != ""} then {
 145             # stdout is wrong.
 146             catch "exec diff -u xargs.out $outfile" diffs
 147             send_log "stdout diffs: $diffs\n"
 148             fail "$testname, wrong stdout output: $cmpout"
 149             return
 150         }
 151     } elseif {[file size xargs.out] != 0} then {
 152         fail "$testname, output on stdout should be empty"
 153         return
 154     }
 155
 156     # if stderr check is enabled,
 157     if {$errfile != ""} then {
 158         if {[file exists $errfile]} then {
 159             set cmp_cmd "cmp xargs.err $errfile"
 160             send_log "$cmp_cmd\n"
 161             catch "exec $cmp_cmd" cmperr
 162             if {$cmperr != ""} then {
 163                 # stderr is wrong
 164                 catch "exec diff -ua xargs.err $errfile" diffs
 165                 send_log "stderr diffs: $diffs\n"
 166                 fail "$testname, wrong stderr output: $cmperr"
 167                 return
 168             }
 169         } elseif {[file size xargs.err] != 0} then {
 170             fail "$testname, output on stderr should be empty"
 171             return
 172         }
 173     }
 174
 175     pass "$testname"
 176 }
 177
 178 # Called by runtest.
 179 # Clean up (remove temporary files) before runtest exits.
 180 proc xargs_exit {} {
 181     catch "exec rm -f xargs.out xargs.err"
 182 }