gcc/testsuite/gcc.dg/guality/guality.exp

   1 # This harness is for tests that should be run at all optimisation levels.
   2
   3 load_lib gcc-dg.exp
   4
   5 # Disable on darwin until radr://7264615 is resolved.
   6 if { [istarget *-*-darwin*] } {
   7   return
   8 }
   9
  10 proc check_guality {args} {
  11     set result [eval check_compile guality_check executable $args "-g -O0"]
  12     set lines [lindex $result 0]
  13     set output [lindex $result 1]
  14     set ret 0
  15     if {[string match "" $lines]} {
  16       set execout [gcc_load "./$output"]
  17       set ret [string match "*1 PASS, 0 FAIL, 0 UNRESOLVED*" $execout]
  18     }
  19     remote_file build delete $output
  20     return $ret
  21 }
  22
  23 # Utility for testing variable values using gdb, invoked via dg-final.
  24 # Call pass if variable has the desired value, otherwise fail.
  25 #
  26 # Argument 0 is the line number on which to put a breakpoint
  27 # Argument 1 is the name of the variable to be checked
  28 # Argument 2 is the expected value of the variable
  29 # Argument 3 handles expected failures and the like
  30 proc gdb-test { args } {
  31     if { ![isnative] || [is_remote target] } { return }
  32
  33     if { [llength $args] >= 4 } {
  34         switch [dg-process-target [lindex $args 3]] {
  35             "S" { }
  36             "N" { return }
  37             "F" { setup_xfail "*-*-*" }
  38             "P" { }
  39         }
  40     }
  41
  42     # This assumes that we are three frames down from dg-test, and that
  43     # it still stores the filename of the testcase in a local variable "name".
  44     # A cleaner solution would require a new DejaGnu release.
  45     upvar 2 name testcase
  46     upvar 2 prog prog
  47
  48     set gdb_name $::env(GUALITY_GDB_NAME)
  49     set testname "$testcase line [lindex $args 0] [lindex $args 1] == [lindex $args 2]"
  50     set output_file "[file rootname [file tail $prog]].exe"
  51     set cmd_file "[file rootname [file tail $prog]].gdb"
  52
  53     set fd [open $cmd_file "w"]
  54     puts $fd "break [lindex $args 0]"
  55     puts $fd "run"
  56     puts $fd "print [lindex $args 1]"
  57     puts $fd "print [lindex $args 2]"
  58     puts $fd "quit"
  59     close $fd
  60
  61     send_log "Spawning: $gdb_name -nx -nw -quiet -x $cmd_file ./$output_file\n"
  62     set res [remote_spawn target "$gdb_name -nx -nw -quiet -x $cmd_file ./$output_file"]
  63     if { $res < 0 || $res == "" } {
  64         unsupported "$testname"
  65         return
  66     }
  67
  68     remote_expect target [timeout_value] {
  69         -re {[\n\r]\$1 = ([^\n\r]*)[\n\r]+\$2 = ([^\n\r]*)[\n\r]} {
  70             set first $expect_out(1,string)
  71             set second $expect_out(2,string)
  72             if { $first == $second } {
  73                 pass "$testname"
  74             } else {
  75                 send_log "$first != $second\n"
  76                 fail "$testname"
  77             }
  78             remote_close target
  79             return
  80         }
  81         # Too old GDB
  82         -re "Unhandled dwarf expression|Error in sourced command file" {
  83             unsupported "$testname"
  84             remote_close target
  85             return
  86         }
  87         timeout {
  88             unsupported "$testname"
  89             remote_close target
  90             return
  91         }
  92     }
  93
  94     remote_close target
  95     unsupported "$testname"
  96     return
  97 }
  98
  99 dg-init
 100
 101 global GDB
 102 if ![info exists ::env(GUALITY_GDB_NAME)] {
 103     if [info exists GDB] {
 104         set guality_gdb_name "$GDB"
 105     } else {
 106         set guality_gdb_name "[transform gdb]"
 107     }
 108     setenv GUALITY_GDB_NAME "$guality_gdb_name"
 109 }
 110
 111 if {[check_guality "
 112   #include \"$srcdir/$subdir/guality.h\"
 113   volatile long int varl = 6;
 114   int main (int argc, char *argv\[\])
 115   {
 116     GUALCHKVAL (varl);
 117     return 0;
 118   }
 119 "]} {
 120   gcc-dg-runtest [lsort [glob $srcdir/$subdir/*.c]] ""
 121 }
 122
 123 if [info exists guality_gdb_name] {
 124     unsetenv GUALITY_GDB_NAME
 125 }
 126
 127 dg-finish