lib/dejagnu.exp

   1 # Copyright (C) 1992-2019, 2020 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 # A hairy pattern to recognize text.
  21 set text "\[- A-Za-z0-9\.\;\"\_\:\'\`\(\)\!\#\=\+\?\&\*<>]"
  22
  23 set SIZE size
  24 if { [which $SIZE] == 0 } {
  25     perror "Can't find $SIZE." 0
  26 }
  27
  28 # Get the size of the various section in OBJECT.
  29 proc exe_size {object} {
  30     global SIZE
  31
  32     # Make sure size exists
  33     if { [which $SIZE] == 0 } {
  34         return [list "-1" "Can't find $SIZE."]
  35     } else {
  36         verbose "Using $SIZE for \"size\" program." 2
  37     }
  38     set status [catch "exec $SIZE -V" output]
  39     if {[regexp "GNU size" $output] == 0} {
  40         perror "Need GNU size from the binutils" 0
  41         return [list "-1" "Need GNU size."]
  42     }
  43
  44     # Get the object size. We pass -x, to force hex output
  45     verbose "Getting the object file size for $object" 2
  46     set status [catch "exec $SIZE -x $object" output]
  47     verbose -log "Size of $object is\n$output" 2
  48
  49     # Remove the header line from the size output. This currently only
  50     # works with GNU size
  51     regsub "text.*filename\[\r\n\]*" $output "" output
  52
  53     # look for the size of the .text section
  54     regexp "\[\r\n\]*0x\[0-9a-fA-F\]*" $output text
  55     regsub "\[\r\n\]*0x\[0-9a-fA-F\]*\[ \t\]*" $output "" output
  56
  57     # look for the size of the .data section
  58     regexp "0x\[0-9a-fA-F\]*\[ \t\]*" $output data
  59     regsub "0x\[0-9a-fA-F\]*\[ \t\]*" $output "" output
  60
  61     # Values returns as hex
  62     return [list $text $data]
  63 }
  64
  65 # Run the host's native compiler, not the cross one. Filter out the
  66 # warnings and other extraneous stuff.
  67 #    Returns:
  68 #       A "" (empty) string if everything worked, or the
  69 #       output if there was a problem.
  70 #
  71 proc host_compile {compline} {
  72     global INCLUDES
  73     global LIBS
  74     global CXX, CC
  75
  76     # execute the compiler
  77     verbose "Compiling for the host using: $CC $INCLUDES $LIBS $compline" 2
  78     set status [catch "exec $CC $INCLUDES $LIBS $compline" comp_output]
  79     verbose "Compiler returned $comp_output" 2
  80
  81     # prune common warnings and other stuff we can safely ignore
  82     set comp_output [prune_warnings $comp_output]
  83
  84     # Trim multiple CR/LF pairs out to keep things consistent
  85     regsub "^\[\r\n\]+" $comp_output "" comp_output
  86
  87     # if we got a compiler error, log it
  88     if { [lindex $status 0] != 0 } {
  89         verbose -log "compiler exited with status [lindex $status 0]"
  90     }
  91     if { [lindex $status 1] ne "" } {
  92         verbose -log "output is:\n[lindex $status 1]" 2
  93     }
  94
  95     # return the filtered output
  96     return $comp_output
  97 }
  98
  99 # Execute the executable file, and analyse the output for the test
 100 # state keywords.
 101 #    Returns:
 102 #       A "" (empty) string if everything worked, or an error message
 103 #       if there was a problem.
 104 #
 105 proc host_execute {args} {
 106     set timeoutmsg "Timed out: Never got started, "
 107     set timeout 100
 108     set file all
 109     set timetol 0
 110     set arguments ""
 111
 112     if { [llength $args] == 0 } {
 113         return "No executable specified."
 114     } else {
 115         set executable [lindex $args 0]
 116         set arguments [lrange $args 1 end]
 117     }
 118
 119     verbose "The executable is $executable" 2
 120     verbose "The arguments are $arguments" 2
 121     if { [file exists "./${executable}"] } {
 122         set executable "./${executable}"
 123     }
 124     if { ![file exists $executable] } {
 125         perror "The executable, \"$executable\" is missing" 0
 126         return "No source file found"
 127     }
 128
 129     # Spawn the executable and look for the DejaGnu output messages.
 130     eval [list spawn -noecho $executable] $arguments
 131     expect {
 132         -re {(?:\A|\n)\t([][[:upper:]]+):([^\n]+)\n} {
 133             set output [string trim $expect_out(2,string)]
 134             switch -- $expect_out(1,string) {
 135                 NOTE            { verbose $output 2 }
 136                 PASSED          { pass $output }
 137                 FAILED          { fail $output }
 138                 XPASSED         { xpass $output }
 139                 XFAILED         { xfail $output }
 140                 UNTESTED        { untested $output }
 141                 UNRESOLVED      { unresolved $output }
 142                 UNSUPPORTED     { unsupported $output }
 143                 WARNING         { warning $output }
 144                 ERROR           { perror $output }
 145                 END {
 146                     expect -re {.+} { exp_continue }
 147                     verbose "All done" 2
 148                 }
 149                 default {
 150                     unresolved "unknown unit test token $expect_out(1,string)"
 151                 }
 152             }
 153             set timetol 0
 154             if { $expect_out(1,string) ne "END" } { exp_continue }
 155         }
 156         -re {^[^\r\n]*([0-9][0-9]:..:..:[^\n]*)\n} {
 157             # No one seems to know why this pattern is here or what it is
 158             # supposed to match.  I suspect that it is obsolete.  -- jcb, 2020
 159             verbose [string trim $expect_out(1,string)] 3
 160             set timetol 0
 161             exp_continue
 162         }
 163         -re {^[^\n]*\n} {
 164             # Skip other lines produced by the test program.
 165             set timetol 0
 166             exp_continue
 167         }
 168         full_buffer {
 169             perror "Expect matching buffer overrun while running\
 170                         $executable $arguments"
 171         }
 172         eof {
 173             warning "Test case did not emit an end marker"
 174         }
 175         timeout {
 176             warning "Timed out executing test case"
 177             if { $timetol <= 2 } {
 178                 incr timetol
 179                 exp_continue
 180             } else {
 181                 catch close
 182                 return "Timed out executing test case"
 183             }
 184         }
 185     }
 186
 187     # force a close of the executable to be safe.
 188     catch close
 189     return ""
 190 }