config/unix.exp

   1 # Copyright (C) 1992-2016 Free Software Foundation, Inc.
   2 #
   3 # This file is part of DejaGnu.
   4 #
   5 # DejaGnu is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # DejaGnu is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with DejaGnu; if not, write to the Free Software Foundation,
  17 # Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # This file was written by Rob Savoye <rob@welcomehome.org>.
  20
  21 if {![info exists board]} {
  22     error "must set $board before loading unix.exp"
  23 }
  24
  25 # For rcp_download, rsh_exec.
  26 load_lib remote.exp
  27
  28 #
  29 # unix_load -- load the program and execute it
  30 #
  31 # See default.exp for explanation of arguments and results.
  32 #
  33
  34
  35 proc unix_load { dest prog args } {
  36     global ld_library_path
  37     global test_timeout
  38     set output ""
  39     set orig_ld_library_path ""
  40
  41     if {![info exists test_timeout]} {
  42         set test_timeout 300
  43     }
  44
  45     if { [llength $args] > 0 } {
  46         set parg [lindex $args 0]
  47     } else {
  48         set parg ""
  49     }
  50
  51     if { [llength $args] > 1 } {
  52         set inp [lindex $args 1]
  53     } else {
  54         set inp ""
  55     }
  56
  57     if {![file exists $prog]} then {
  58         # We call both here because this should never happen.
  59         perror "$prog does not exist in unix_load."
  60         verbose -log "$prog does not exist." 3
  61         return "untested"
  62     }
  63     verbose "loading to $dest" 2
  64     if {![isremote $dest]} {
  65         if { $inp ne "" } {
  66             set command "$prog $parg < $inp"
  67         } else {
  68             set command "$prog $parg"
  69         }
  70
  71         if {![info exists ld_library_path]} {
  72             set ld_library_path ""
  73         }
  74
  75         set orig_ld_library_path "[getenv LD_LIBRARY_PATH]"
  76         setenv LD_LIBRARY_PATH $ld_library_path:$orig_ld_library_path
  77         setenv SHLIB_PATH $ld_library_path:$orig_ld_library_path
  78         verbose -log "Setting LD_LIBRARY_PATH to $ld_library_path:$orig_ld_library_path" 2
  79         verbose -log "Execution timeout is: $test_timeout" 2
  80
  81         # Prepend shell name (e.g., qemu emulator) to the command.
  82         if {[board_info $dest exists exec_shell]} {
  83             set command "[board_info $dest exec_shell] $command"
  84         }
  85
  86         set id [remote_spawn $dest $command "readonly"]
  87         if { $id < 0 } {
  88             set output "remote_spawn failed"
  89             set status -1
  90         } else {
  91             set status [remote_wait $dest $test_timeout]
  92             set output [lindex $status 1]
  93             set status [lindex $status 0]
  94         }
  95         # Unset them so we don't potentially get hosed when we try to run a
  96         # non-testcase executable. (Setting LD_LIBRARY_PATH is the wrong
  97         # fix in the first place; this just tries to minimize the resulting
  98         # crap.)
  99         if {[info exists ld_library_path]} {
 100             setenv LD_LIBRARY_PATH $orig_ld_library_path
 101             setenv SHLIB_PATH $orig_ld_library_path
 102         }
 103     } else {
 104         set remotefile [file tail $prog]
 105         set remotefile [remote_download $dest $prog $remotefile]
 106         if { $remotefile eq "" } {
 107             verbose -log "Download of $prog to [board_info $dest name] failed." 3
 108             return [list "unresolved" ""]
 109         }
 110         if {[board_info $dest exists remote_link]} {
 111             if {[[board_info $dest remote_link] $remotefile]} {
 112                 verbose -log "Couldn't do remote link"
 113                 remote_exec $dest "\\rm -f $remotefile"
 114                 return [list "unresolved" ""]
 115             }
 116
 117             verbose "$prog linked ok" 3
 118         } else {
 119             # rcp's to lynx seem not to get marked executable
 120             set status [remote_exec $dest "chmod +x $remotefile"]
 121             if { [lindex $status 0] != 0 } {
 122                 remote_file $dest delete $remotefile.o $remotefile
 123                 verbose -log "chmod +x of $prog on $dest failed." 3
 124                 return [list "unresolved" ""]
 125             }
 126         }
 127
 128         # Prepend shell name (e.g., qemu emulator) to the command.
 129         if {[board_info $dest exists exec_shell]} {
 130             set remotecmd "[board_info $dest exec_shell] $remotefile"
 131         } else {
 132             set remotecmd "$remotefile"
 133         }
 134
 135         set status [remote_exec $dest $remotefile $parg $inp]
 136         remote_file $dest delete $remotefile.o $remotefile
 137         if { [lindex $status 0] < 0 } {
 138             verbose -log "Couldn't execute $prog, [lindex $status 1]" 3
 139             return [list "unresolved" ""]
 140         }
 141         set output [lindex $status 1]
 142         set status [lindex $status 0]
 143     }
 144
 145     setenv LD_LIBRARY_PATH $orig_ld_library_path
 146     setenv SHLIB_PATH $orig_ld_library_path
 147
 148     verbose "Executed $prog, status $status" 2
 149     if {$output ne ""} {
 150         verbose -- $output 2
 151     }
 152     if { $status == 0 } {
 153         set result "pass"
 154     } else {
 155         set result "fail"
 156     }
 157     return [list $result $output]
 158 }
 159
 160 set_board_info remotedir "/tmp/runtest.[pid]"
 161 set_board_info protocol  "unix"