diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/framework.exp | 131 | ||||
| -rw-r--r-- | lib/libgloss.exp | 40 | ||||
| -rw-r--r-- | lib/rsh.exp | 3 | ||||
| -rw-r--r-- | lib/ssh.exp | 5 | ||||
| -rw-r--r-- | lib/target.exp | 104 |
5 files changed, 269 insertions, 14 deletions
diff --git a/lib/framework.exp b/lib/framework.exp index e6ce197..6d7cf4d 100644 --- a/lib/framework.exp +++ b/lib/framework.exp @@ -16,7 +16,60 @@ # along with DejaGnu; if not, write to the Free Software Foundation, # Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. -# This file was written by Rob Savoye <rob@welcomehome.org>. +# This file was originally written by Rob Savoye <rob@welcomehome.org>. + +## Internal infrastructure + +namespace eval ::dejagnu::group { + variable names [list] + variable files [list] +} + +proc ::dejagnu::group::check_name { name } { + return [string is graph -strict $name] +} + +proc ::dejagnu::group::current {} { + variable names + return [join $names "/"] +} + +proc ::dejagnu::group::push { name file } { + variable names + variable files + lappend names $name + lappend files $file +} +proc ::dejagnu::group::pop { name file } { + variable names + variable files + + if { $file ne [lindex $files end] + || $name ne [lindex $names end] } { + error "expected to close group {$name} from {$file}\n\ + actually found group {[lindex $names end]}\ + from {[lindex $files end]}" + } else { + set names [lreplace $names end end] + set files [lreplace $files end end] + } +} +proc ::dejagnu::group::pop_to_file { file } { + variable names + variable files + + while { $file ne [lindex $files end] } { + perror "closing forgotten group {[::dejagnu::group::current]}\ + from {[lindex $files end]}" 0 + set names [lreplace $names end end] + set files [lreplace $files end end] + if { [llength $names] < 1 } { + error "no more groups while unwinding to file $file" + } + } +} + +## General code; not yet sorted under headings # These variables are local to this file. # This or more warnings and a test fails. @@ -1019,10 +1072,30 @@ proc incr_count { name args } { proc testsuite { subcommand args } { if { $subcommand eq "file" } { testsuite_file $args + } elseif { $subcommand eq "can" } { + testsuite_can $args } else { error "unknown \"testsuite\" command: testsuite $subcommand $args" } } +namespace eval ::dejagnu {} + +# Feature test +# +proc testsuite_can { argv } { + verbose "entering testsuite can $argv" 3 + + if { [lrange $argv 0 1] eq "call api" } { + set call [lrange $argv 2 end] + set result [info exists ::dejagnu::apilist($call)] + } else { + error "unknown feature test: testsuite can $argv" + } + + verbose "leaving testsuite can: $result" 3 + return $result +} +array set ::dejagnu::apilist { {testsuite can call api} 1 } # Return a full file name in or near the testsuite # @@ -1075,3 +1148,59 @@ proc testsuite_file { argv } { verbose "leaving testsuite file: $result" 3 return $result } +array set ::dejagnu::apilist { {testsuite file} 1 } + +# Return or provide information about the current dynamic state. (multiplex) +# +proc testcase { subcommand args } { + if { $subcommand eq "group" } { + testcase_group $args + } else { + error "unknown \"testcase\" command: testcase $subcommand $args" + } +} + +# Indicate group boundaries or return current group +# +proc testcase_group { argv } { + verbose "entering testcase group $argv" 3 + set argc [llength $argv] + + if { $argc == 0 } { + set result [::dejagnu::group::current] + } else { + set what [lindex $argv 0] + set name [lindex $argv 1] + + if { $what eq "begin" } { + if { ![::dejagnu::group::check_name $name] } { + error "group name '$name' is not valid" + } + ::dejagnu::group::push $name [uplevel 2 info script] + set result $name + } elseif { $what eq "end" } { + if { ![::dejagnu::group::check_name $name] } { + error "group name '$name' is not valid" + } + ::dejagnu::group::pop $name [uplevel 2 info script] + set result $name + } elseif { $what eq "eval" } { + if { ![::dejagnu::group::check_name $name] } { + error "group name '$name' is not valid" + } + ::dejagnu::group::push $name [uplevel 2 info script] + set result [uplevel 2 [lindex $argv 2]] + ::dejagnu::group::pop $name [uplevel 2 info script] + } else { + error "unknown group operation: testcase group $argv" + } + } + + verbose "leaving testcase group: $result" 3 + return $result +} +array set ::dejagnu::apilist { + {testcase group} 1 + {testcase group begin} 1 {testcase group end} 1 + {testcase group eval} 1 +} diff --git a/lib/libgloss.exp b/lib/libgloss.exp index 56a9728..8e8a9ce 100644 --- a/lib/libgloss.exp +++ b/lib/libgloss.exp @@ -765,6 +765,46 @@ proc find_gnatmake {} { return $CC } +proc find_go {} { + global tool_root_dir + + set GO "" + + if {![is_remote host]} { + set file [lookfor_file $tool_root_dir gccgo] + if { $file ne "" } { + set root [file dirname $file] + set GO "$file -B$root/gcc/" + } + } + + if { $GO eq "" } { + set GO [transform gccgo] + } + + return $GO +} + +proc find_go_linker {} { + return [find_go] +} + +proc find_rustc {} { + global tool_root_dir + if {![is_remote host]} { + set rustc [lookfor_file $tool_root_dir rustc] + if {$rustc eq ""} { + set rustc rustc + } + } else { + set rustc "" + } + if {$rustc ne ""} { + append rustc " --color never" + } + return $rustc +} + proc find_nm {} { global tool_root_dir diff --git a/lib/rsh.exp b/lib/rsh.exp index 5b583c6..43f5430 100644 --- a/lib/rsh.exp +++ b/lib/rsh.exp @@ -283,8 +283,5 @@ proc rsh_exec { boardname program pargs inp outp } { return [list -1 "Couldn't parse $RSH output, $output."] } regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output - # Delete one trailing \n because that is what `exec' will do and we want - # to behave identical to it. - regsub "\n$" $output "" output return [list [expr {$status != 0}] $output] } diff --git a/lib/ssh.exp b/lib/ssh.exp index 0cf0f8d..3c7b840 100644 --- a/lib/ssh.exp +++ b/lib/ssh.exp @@ -171,7 +171,7 @@ proc ssh_exec { boardname program pargs inp outp } { # We use && here, as otherwise the echo always works, which makes it look # like execution succeeded when in reality it failed. - set ret [local_exec "$SSH $ssh_useropts $ssh_user$hostname sh -c '$program $pargs && echo XYZ\\\${?}ZYX \\; rm -f $program'" $inp $outp $timeout] + set ret [local_exec "$SSH $ssh_useropts $ssh_user$hostname sh -c '$program $pargs 2>&1 && echo XYZ\\\${?}ZYX \\; rm -f $program'" $inp $outp $timeout] set status [lindex $ret 0] set output [lindex $ret 1] @@ -194,9 +194,6 @@ proc ssh_exec { boardname program pargs inp outp } { return [list -1 "Couldn't parse $SSH output, $output."] } regsub "XYZ(\[0-9\]*)ZYX\n?" $output "" output - # Delete one trailing \n because that is what `exec' will do and we want - # to behave identical to it. - regsub "\n$" $output "" output return [list [expr {$status != 0}] $output] } diff --git a/lib/target.exp b/lib/target.exp index d240007..30f6eb3 100644 --- a/lib/target.exp +++ b/lib/target.exp @@ -311,10 +311,16 @@ proc default_target_compile {source destfile type options} { error "Must supply an output filename for the compile to default_target_compile" } + set early_flags "" set add_flags "" set libs "" set compiler_type "c" set compiler "" + set linker "" + # linker_opts_order is one of "sources-then-flags", "flags-then-sources". + # The order matters for things like -Wl,--as-needed. The default is to + # preserve existing behavior. + set linker_opts_order "sources-then-flags" set ldflags "" set dest [target_info name] @@ -395,6 +401,38 @@ proc default_target_compile {source destfile type options} { } } + if { $i eq "go" } { + set compiler_type "go" + if {[board_info $dest exists goflags]} { + append add_flags " [board_info $dest goflags]" + } + if {[board_info $dest exists gocompiler]} { + set compiler [board_info $dest gocompiler] + } else { + set compiler [find_go] + } + if {[board_info $dest exists golinker]} { + set linker [board_info $dest golinker] + } else { + set linker [find_go_linker] + } + if {[board_info $dest exists golinker_opts_order]} { + set linker_opts_order [board_info $dest golinker_opts_order] + } + } + + if { $i eq "rust" } { + set compiler_type "rust" + if {[board_info $dest exists rustflags]} { + append add_flags " [board_info $dest rustflags]" + } + if {[board_info $dest exists rustcompiler]} { + set compiler [board_info $dest rustcompiler] + } else { + set compiler [find_rustc] + } + } + if {[regexp "^dest=" $i]} { regsub "^dest=" $i "" tmp if {[board_info $tmp exists name]} { @@ -407,6 +445,14 @@ proc default_target_compile {source destfile type options} { regsub "^compiler=" $i "" tmp set compiler $tmp } + if {[regexp "^linker=" $i]} { + regsub "^linker=" $i "" tmp + set linker $tmp + } + if {[regexp "^early_flags=" $i]} { + regsub "^early_flags=" $i "" tmp + append early_flags " $tmp" + } if {[regexp "^additional_flags=" $i]} { regsub "^additional_flags=" $i "" tmp append add_flags " $tmp" @@ -451,6 +497,9 @@ proc default_target_compile {source destfile type options} { global F77_FOR_TARGET global F90_FOR_TARGET global GNATMAKE_FOR_TARGET + global GO_FOR_TARGET + global GO_LD_FOR_TARGET + global RUSTC_FOR_TARGET if {[info exists GNATMAKE_FOR_TARGET]} { if { $compiler_type eq "ada" } { @@ -488,6 +537,25 @@ proc default_target_compile {source destfile type options} { } } + if { $compiler_type eq "go" } { + if {[info exists GO_FOR_TARGET]} { + set compiler $GO_FOR_TARGET + } + if {[info exists GO_LD_FOR_TARGET]} { + set linker $GO_LD_FOR_TARGET + } + } + + if {[info exists RUSTC_FOR_TARGET]} { + if {$compiler_type eq "rust"} { + set compiler $RUSTC_FOR_TARGET + } + } + + if { $type eq "executable" && $linker ne "" } { + set compiler $linker + } + if { $compiler eq "" } { if { [board_info $dest exists compiler] } { set compiler [board_info $dest compiler] @@ -506,7 +574,11 @@ proc default_target_compile {source destfile type options} { } if {$type eq "object"} { - append add_flags " -c" + if {$compiler_type eq "rust"} { + append add_flags " --emit obj" + } else { + append add_flags " -c" + } } if { $type eq "preprocess" } { @@ -514,7 +586,11 @@ proc default_target_compile {source destfile type options} { } if { $type eq "assembly" } { - append add_flags " -S" + if {$compiler_type eq "rust"} { + append add_flags " --emit asm" + } else { + append add_flags " -S" + } } if {[board_info $dest exists cflags]} { @@ -634,10 +710,26 @@ proc default_target_compile {source destfile type options} { # This is obscure: we put SOURCES at the end when building an # object, because otherwise, in some situations, libtool will # become confused about the name of the actual source file. - if {$type eq "object"} { - set opts "$add_flags $sources" - } else { - set opts "$sources $add_flags" + switch $type { + "object" { + set opts "$early_flags $add_flags $sources" + } + "executable" { + switch $linker_opts_order { + "flags-then-sources" { + set opts "$early_flags $add_flags $sources" + } + "sources-then-flags" { + set opts "$early_flags $sources $add_flags" + } + default { + error "Invalid value for board_info linker_opts_order" + } + } + } + default { + set opts "$early_flags $sources $add_flags" + } } if {[isremote host]} { |