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, see <http://www.gnu.org/licenses/>.
  17
  18 # This file was written by Rob Savoye <rob@welcomehome.org>.
  19
  20 if {![info exists board]} {
  21     error "must set $board before loading unix.exp"
  22 }
  23
  24 # For rcp_download, rsh_exec.
  25 load_lib remote.exp
  26
  27 #
  28 # unix_load -- load the program and execute it
  29 #
  30 # See default.exp for explanation of arguments and results.
  31 #
  32
  33
  34 proc unix_load { dest prog args } {
  35     global ld_library_path
  36     global test_timeout
  37     set output ""
  38     set orig_ld_library_path ""
  39
  40     set wait_timeout 300
  41     if {[info exists test_timeout]} {
  42         set wait_timeout $test_timeout
  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
  80         # Prepend shell name (e.g., qemu emulator) to the command.
  81         if {[board_info $dest exists exec_shell]} {
  82             set command "[board_info $dest exec_shell] $command"
  83         }
  84
  85         verbose -log "Executing on $dest: $command (timeout = $wait_timeout)" 2
  86
  87         set id [remote_spawn $dest $command "readonly"]
  88         if { $id < 0 } {
  89             set output "remote_spawn failed"
  90             set status -1
  91         } else {
  92             set status [remote_wait $dest $wait_timeout]
  93             set output [lindex $status 1]
  94             set status [lindex $status 0]
  95         }
  96         # Unset them so we don't potentially get hosed when we try to run a
  97         # non-testcase executable. (Setting LD_LIBRARY_PATH is the wrong
  98         # fix in the first place; this just tries to minimize the resulting
  99         # crap.)
 100         if {[info exists ld_library_path]} {
 101             setenv LD_LIBRARY_PATH $orig_ld_library_path
 102             setenv SHLIB_PATH $orig_ld_library_path
 103         }
 104     } else {
 105         set remotefile [file tail $prog]
 106         set remotefile [remote_download $dest $prog $remotefile]
 107         if { $remotefile eq "" } {
 108             verbose -log "Download of $prog to [board_info $dest name] failed." 3
 109             return [list "unresolved" ""]
 110         }
 111         if {[board_info $dest exists remote_link]} {
 112             if {[[board_info $dest remote_link] $remotefile]} {
 113                 verbose -log "Couldn't do remote link"
 114                 remote_exec $dest "\\rm -f $remotefile"
 115                 return [list "unresolved" ""]
 116             }
 117
 118             verbose "$prog linked ok" 3
 119         } else {
 120             # rcp's to lynx seem not to get marked executable
 121             set status [remote_exec $dest "chmod +x $remotefile"]
 122             if { [lindex $status 0] != 0 } {
 123                 remote_file $dest delete $remotefile.o $remotefile
 124                 verbose -log "chmod +x of $prog on $dest failed." 3
 125                 return [list "unresolved" ""]
 126             }
 127         }
 128
 129         # Prepend shell name (e.g., qemu emulator) to the command.
 130         if {[board_info $dest exists exec_shell]} {
 131             set remotecmd "[board_info $dest exec_shell] $remotefile"
 132         } else {
 133             set remotecmd "$remotefile"
 134         }
 135
 136         set status [remote_exec $dest $remotefile $parg $inp "" $wait_timeout]
 137         remote_file $dest delete $remotefile.o $remotefile
 138         if { [lindex $status 0] < 0 } {
 139             verbose -log "Couldn't execute $prog, [lindex $status 1]" 3
 140             return [list "unresolved" ""]
 141         }
 142         set output [lindex $status 1]
 143         set status [lindex $status 0]
 144     }
 145
 146     setenv LD_LIBRARY_PATH $orig_ld_library_path
 147     setenv SHLIB_PATH $orig_ld_library_path
 148
 149     verbose "Executed $prog, status $status" 2
 150     if {$output ne ""} {
 151         verbose -- $output 2
 152     }
 153     if { $status == 0 } {
 154         set result "pass"
 155     } else {
 156         set result "fail"
 157     }
 158     return [list $result $output]
 159 }
 160
 161 set_board_info remotedir "/tmp/runtest.[pid]"
 162 set_board_info protocol  "unix"