home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / A / FIND / FINDUTIL.1 / FINDUTIL / findutils-4.1 / testsuite / config / unix.exp
Encoding:
Text File  |  1994-11-03  |  2.9 KB  |  110 lines
  1. # -*- TCL -*-
  2. # Test-specific TCL procedures required by DejaGNU.
  3. # Copyright (C) 1994 Free Software Foundation, Inc.
  4.  
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or
  8. # (at your option) any later version.
  9. # 
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. # GNU General Public License for more details.
  14. # 
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the Free Software
  17. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19. # Modified by David MacKenzie <djm@gnu.ai.mit.edu> from the gcc files
  20. # written by Rob Savoye <rob@cygnus.com>.
  21.  
  22.  
  23. # Called by runtest.
  24. # Extract and print the version number of xargs.
  25. proc xargs_version {} {
  26.     global XARGS
  27.     global XARGSFLAGS
  28.  
  29.     if {[which $XARGS] != 0} then {
  30.     set tmp [ eval exec $XARGS $XARGSFLAGS --version </dev/null ]
  31.     regexp "version.*$" $tmp version
  32.     if [info exists version] then {
  33.         clone_output "[which $XARGS] $version\n"
  34.     } else {
  35.         warning "cannot get version from $tmp."
  36.     }
  37.     } else {
  38.     warning "$XARGS, program does not exist"
  39.     }
  40. }
  41.  
  42. # Run xargs and leave the output in $comp_output.
  43. # Called by individual test scripts.
  44. proc xargs_start { passfail options infile } {
  45.     global verbose
  46.     global XARGS
  47.     global XARGSFLAGS
  48.     global comp_output
  49.  
  50.     if {[which $XARGS] == 0} then {
  51.     error "$XARGS, program does not exist"
  52.     exit 1
  53.     }
  54.  
  55.     set fail_good [string match "f*" $passfail]
  56.  
  57.     set scriptname [uplevel {info script}]
  58.     set testbase [file rootname $scriptname]
  59.     set testname [file tail $testbase]
  60.  
  61.     set outfile "$testbase.xo"
  62.     if {$infile != ""} then {
  63.     set infile "[file dirname [file dirname $testbase]]/inputs/$infile"
  64.     } else {
  65.     set infile /dev/null
  66.     }
  67.  
  68.     set cmd "$XARGS $XARGSFLAGS $options < $infile > xargs.out"
  69.     send_log "$cmd\n"
  70.     if $verbose>1 then {
  71.     send_user "Spawning \"$cmd\"\n"
  72.     }
  73.  
  74.     catch "exec $cmd" comp_output
  75.     if {$comp_output != ""} then {
  76.     send_log "$comp_output\n"
  77.     if $verbose>1 then {
  78.         send_user "$comp_output\n"
  79.     }
  80.     if $fail_good then {
  81.         pass "$testname"
  82.     } else {
  83.         fail "$testname, $comp_output"
  84.     }
  85.     return
  86.     }
  87.  
  88.     if [file exists $outfile] then {
  89.     set cmp_cmd "cmp xargs.out $outfile"
  90.     send_log "$cmp_cmd\n"
  91.     catch "exec $cmp_cmd" cmpout
  92.     if {$cmpout != ""} then {
  93.         fail "$testname, $cmpout"
  94.         return
  95.     }
  96.     } else {
  97.     if {[file size xargs.out] != 0} then {
  98.         fail "$testname, output should be empty"
  99.         return
  100.     }
  101.     }
  102.     pass "$testname"
  103. }
  104.  
  105. # Called by runtest.
  106. # Clean up (remove temporary files) before runtest exits.
  107. proc xargs_exit {} {
  108.     catch "exec rm -f xargs.out"
  109. }
  110.