gcc/testsuite/lib/old-dejagnu.exp

   1 # Copyright (C) 1988, 90, 91, 92, 1994, 1996, 1997, 2000, 2001 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  16
  17 # This file was written by Rob Savoye. (rob@cygnus.com)
  18 # With modifications by Mike Stump <mrs@cygnus.com>.
  19
  20 # These tests come from the original DejaGnu test suite
  21 # developed at Cygnus Support. If this isn't deja gnu, I
  22 # don't know what is.
  23 #
  24 # Language independence is achieved by:
  25 #
  26 # 1) Using global $tool to indicate the language (eg: gcc, g++, etc.).
  27 #    This should only be used to look up other objects.  We don't want to
  28 #    have to add code for each new language that is supported.  If this is
  29 #    done right, no code needs to be added here for each new language.
  30 #
  31 # 2) Passing compiler options in as arguments.
  32 #
  33 # We require a bit of smarts in our caller to isolate us from the vagaries of
  34 # each language.  See old-deja.exp for the g++ example.
  35
  36 # Useful subroutines.
  37
  38 # process-option -- Look for and process a test harness option in the testcase.
  39 #
  40 # PROG is the pathname of the testcase.
  41 # OPTION is the string to look for.
  42 # MESSAGE is what to print if $verbose > 1.
  43 # FLAG_NAME is one of ERROR, WARNING, etc.
  44 # PATTERN is ???
  45
  46 proc process-option { prog option message flag_name pattern } {
  47     global verbose
  48
  49     set result ""
  50
  51     set tmp [grep $prog "$option.*" line]
  52     if ![string match "" $tmp] then {
  53         foreach i $tmp {
  54             #send_user "Found: $i\n"
  55             set xfail_test 0
  56             set triplet_match 0
  57             regsub "\\*/$" [string trim $i] "" i
  58             if [regexp "LINE +\[0-9\]+" $i xopt] then {
  59                 regsub "LINE" $xopt "" xopt;
  60                 regsub "LINE +\[0-9\]+" $i "" i
  61                 set i [lreplace $i 0 0 [expr "${xopt}-0"]];
  62             }
  63             if [regexp "XFAIL( +\[^ \]+-\[^ \]+-\[^ \]+)*" $i xopt] then {
  64                 set xfail_test 1
  65                 regsub "XFAIL( +\[^ \]+-\[^ \]+-\[^ \]+)*" $i "" i
  66                 regsub "XFAIL" $xopt "" xopt
  67                 if ![string match "" [string trim $xopt]] then {
  68                     foreach triplet $xopt {
  69                         if [istarget $triplet] {
  70                             set triplet_match 1;
  71                             break;
  72                         }
  73                     }
  74                 } else {
  75                     set triplet_match 1
  76                 }
  77             }
  78             set compos [expr [llength $option] + 1] ;# Start of comment, if any
  79             if { $xfail_test && $triplet_match } then {
  80                 lappend result [list [lindex $i 0] "X$flag_name" [lrange $i $compos end] "$pattern"]
  81             } else {
  82                 lappend result [list [lindex $i 0] "$flag_name" [lrange $i $compos end] "$pattern"]
  83             }
  84             if { $verbose > 1 } then {
  85                 if [string match "" [lrange $i $compos end]] then {
  86                     send_user "Found $message for line [lindex $i 0]\n"
  87                 } else {
  88                     send_user "Found $message \"[lrange $i $compos end]\" for line [lindex $i 0]\n"
  89                 }
  90             }
  91         }
  92     }
  93
  94     #send_user "Returning: $result\n"
  95     return $result
  96 }
  97
  98 # old-dejagnu-init -- set up some statistics collectors
  99 #
 100 # There currently isn't much to do, but always calling it allows us to add
 101 # enhancements without having to update our callers.
 102 # It must be run before calling `old-dejagnu'.
 103
 104 proc old-dejagnu-init { } {
 105 }
 106
 107 # old-dejagnu-stat -- print the stats of this run
 108 #
 109 # ??? This is deprecated, and can be removed.
 110
 111 proc old-dejagnu-stat { } {
 112 }
 113
 114 # old-dejagnu -- runs an old style DejaGnu test.
 115 #
 116 # Returns 0 if successful, 1 if their were any errors.
 117 # PROG is the full path name of the file to compile.
 118 #
 119 # CFLAGSX is the options to always pass to the compiler.
 120 #
 121 # DEFAULT_CFLAGS are additional options if the testcase has none.
 122 #
 123 # LIBS_VAR is the name of the global variable containing libraries (-lxxx's).
 124 # This is also ignored.
 125 #
 126 # LIBS is any additional libraries to link with.  This *cannot* be specified
 127 # with the compiler flags because otherwise gcc will issue, for example, a
 128 # "-lg++ argument not used since linking not done" warning which will screw up
 129 # the test for excess errors.  We could ignore such messages instead.
 130 #
 131 # Think of "cflags" here as "compiler flags", not "C compiler flags".
 132
 133 proc old-dejagnu { compiler prog name cflagsx default_cflags libs } {
 134     global verbose
 135     global tool
 136     global subdir               ;# eg: g++.old-dejagnu
 137     global host_triplet
 138     global tmpdir
 139
 140     set runflag 1
 141     set execbug_flag 0
 142     set excessbug_flag 0
 143     set pattern ""
 144     set text "\[- A-Za-z0-9\.\;\"\_\:\'\`\(\)\!\#\=\+\?\&\*]*"
 145
 146     if ![info exists tmpdir] then {
 147         set tmpdir "/tmp"
 148     }
 149
 150 # look for keywords that change the compiler options
 151 #
 152 # There are two types of test, negative and affirmative. Negative
 153 # tests have the keyword of "ERROR - " or "WARNING - " on the line
 154 # expected to produce an error. This is followed by the pattern. If
 155 # the desired error or warning message appears, then the test passes.
 156 #
 157 # Affirmative test can have the following keywords "gets bogus error",
 158 # "causes invalid C code", "invalid assembly code", "causes abort",
 159 # "causes segfault", "causes linker error", "execution test fails". If
 160 # the pattern after the keyword matches, then the test is a failure.
 161 #
 162 # One can specify particular targets for expected failures of the above
 163 # keywords by putting "XFAIL target-triplet" after the keyword.
 164 #
 165 # Example:
 166 #
 167 # void f ()
 168 #{
 169 #  int i[2], j;
 170 #  A a (int (i[1]), j);         // gets bogus error - late parsing XFAIL *-*-*
 171 #  A b (int (i[1]), int j);     // function
 172 #  a.k = 0;                     // gets bogus error - late parsing XFAIL *-*-*
 173 #  b (i, j);
 174 #}
 175 #
 176 # Note also, that one can add a comment with the keyword ("late parsing"
 177 # in the above example).
 178 #
 179 # If any of the tests contain the special pattern "FIXME -" that test is
 180 # not run because it will produce incorrect output.
 181 #
 182 # Testcases can supply special options to the compiler with a line containing
 183 # "Special.*Options: ...", where ".*" can be anything (eg: g++) and "..." are
 184 # the additional options to pass to the compiler.  Nothing else may appear
 185 # after the options.  IE: for a C testcase
 186 # /* Special Options: -fomit-frame-pointer */  /* Oops! */
 187 # is wrong,
 188 # /* Special Options: -fomit-frame-pointer */
 189 # is right.  If no such Special Options are found, $default_cflags is used.
 190 # FIXME: Can there be multiple lines of these?
 191 #
 192 # Other keywords: "Build don't link:", "Build don't run:", "Build then link:",
 193 #                 "Additional sources: <file>.cc ..."
 194
 195 # $name is now passed in.
 196 #    set name "[file tail [file dirname $prog]]/[file tail $prog]"
 197
 198     set tmp [grep $prog "FIXME -.*"]
 199     if ![string match "" $tmp] then {
 200         foreach i $tmp {
 201             warning "[file tail [file dirname $prog]]/[file tail $prog] [lrange $i 2 end]"
 202         }
 203         return 1
 204     }
 205
 206     set tmp [lindex [grep $prog "Special.*Options:.*"] 0]
 207     set cflags ""
 208
 209     regsub -all "\n\[^\n\]+(\n|$)" $tmp "\n" tmp
 210     set tmp [string trim $tmp]
 211     if ![string match "" $tmp] then {
 212         regsub "^.*Special.*Options:" $tmp "" tmp
 213         lappend cflags "additional_flags=$tmp"
 214         verbose "Adding special options $tmp" 2
 215     } else {
 216         lappend cflags "additional_flags=$default_cflags"
 217     }
 218
 219     if { $cflagsx != "" } {
 220         lappend cflags "additional_flags=$cflagsx"
 221     }
 222
 223     set tmp [lindex [grep $prog "Additional sources: .*"] 0]
 224     regsub -all "\n\[^\n\]+(\n|$)" $tmp "\n" tmp
 225     set tmp [string trim $tmp]
 226     if ![string match "" $tmp] then {
 227         regsub "^.*Additional.*sources:" $tmp "" tmp
 228         regsub -all " " $tmp " [file dirname $prog]/" tmp
 229         lappend cflags "additional_flags=$tmp"
 230         verbose "Adding sources $tmp"
 231     }
 232
 233     lappend cflags "compiler=$compiler"
 234
 235     regsub -all "\[./\]" "$name" "-" output;
 236     set output "$tmpdir/$output.exe";
 237     set compile_type "executable"
 238
 239     set tmp [lindex [grep $prog "Build don.t link:"] 0]
 240     if ![string match "" $tmp] then {
 241         set compile_type "object"
 242         set runflag 0
 243         set output "$tmpdir/[file tail [file rootname $prog]].o"
 244         verbose "Will compile $prog to object" 3
 245     }
 246
 247     set tmp [lindex [grep $prog "Build then link:"] 0]
 248     if ![string match "" $tmp] then {
 249         set compile_type "object"
 250         set runflag 2
 251         set final_output "$output"
 252         set output "$tmpdir/[file tail [file rootname $prog]].o"
 253         verbose "Will compile $prog to object, then link it" 3
 254     }
 255
 256     set tmp [lindex [grep $prog "Build don.t run:"] 0]
 257     if ![string match "" $tmp] then {
 258         set runflag 0
 259         verbose "Will compile $prog to binary" 3
 260     }
 261
 262     set tmp [grep $prog "Skip if (|not )feature:.*"];
 263     if { $tmp != "" } {
 264         foreach line $tmp {
 265             if [regexp "Skip if not feature" $line] {
 266                 set not 1;
 267             } else {
 268                 set not 0;
 269             }
 270             regsub "^.*Skip if (|not )feature:\[        \]*" "$line" "" i;
 271             set is_set 0;
 272             foreach j $i {
 273                 if [target_info exists $j] {
 274                     set is_set 1;
 275                     break;
 276                 }
 277             }
 278             if { $is_set != $not } {
 279                 untested "$name: Test skipped: ${line}($j set)"
 280                 return;
 281             }
 282         }
 283     }
 284
 285     set tmp [grep $prog "Skip if (|not )target:.*"];
 286     if { $tmp != "" } {
 287         foreach line $tmp {
 288             if [regexp "Skip if not target:" $line] {
 289                 set not 1;
 290             } else {
 291                 set not 0;
 292             }
 293             regsub "^.*Skip if (|not )target:\[         \]*" "$line" "" i;
 294             set ist 0;
 295             foreach j $i {
 296                 if [istarget $j] {
 297                     set ist 1;
 298                     break;
 299                 }
 300             }
 301             if { $ist != $not } {
 302                 untested "$name: Test skipped: ${line}"
 303                 return;
 304             }
 305         }
 306     }
 307
 308     if ![isnative] {
 309         set tmp [lindex [grep $prog "Skip if not native"] 0];
 310         if { $tmp != "" } {
 311             untested "$name: Test skipped because not native";
 312             return;
 313         }
 314     } else {
 315         set tmp [lindex [grep $prog "Skip if native"] 0];
 316         if { $tmp != "" } {
 317             untested "$name: Test skipped because native";
 318             return;
 319         }
 320     }
 321
 322     lappend cflags "libs=$libs"
 323
 324 #
 325 # Look for the other keywords and extract the error messages.
 326 # `message' contains all the things we found.
 327 # ??? We'd like to use lappend below instead of concat, but that doesn't
 328 # work (adds an extra level of nesting to $tmp).
 329 #
 330
 331     set message ""
 332
 333     set tmp [process-option $prog "ERROR - " "an error message" ERROR "$text error$text"]
 334     if ![string match "" $tmp] then {
 335         set runflag 0
 336         set message [concat $message $tmp]
 337     }
 338
 339     set tmp [process-option $prog "WARNING - " "a warning message" WARNING "warning"]
 340     if ![string match "" $tmp] then {
 341         set runflag 0
 342         set message [concat $message $tmp]
 343     }
 344
 345     set tmp [process-option $prog "gets bogus error" "a bogus error" BOGUS $text]
 346     if ![string match "" $tmp] then {
 347         set message [concat $message $tmp]
 348     }
 349
 350     set tmp [process-option $prog "causes invalid C code" "a bad C translation" BADC $text]
 351     if ![string match "" $tmp] then {
 352         set message [concat $message $tmp]
 353     }
 354
 355     set tmp [process-option $prog "invalid assembly code" "some invalid assembly code" BADASM $text]
 356     if ![string match "" $tmp] then {
 357         set message [concat $message $tmp]
 358     }
 359
 360     set tmp [process-option $prog "causes abort" "an abort cause" ABORT $text]
 361     if ![string match "" $tmp] then {
 362         set message [concat $message $tmp]
 363     }
 364
 365     set tmp [process-option $prog "causes segfault" "a segfault cause" SEGFAULT $text]
 366     if ![string match "" $tmp] then {
 367         set message [concat $message $tmp]
 368     }
 369
 370     set tmp [process-option $prog "causes linker error" "a linker error" LINKER $text]
 371     if ![string match "" $tmp] then {
 372         set message [concat $message $tmp]
 373     }
 374
 375     set tmp [process-option $prog "execution test fails" "an execution failure" EXECO $text]
 376     if ![string match "" $tmp] then {
 377         set execbug_flag 1
 378         set message [concat $message $tmp]
 379         warning "please use execution test - XFAIL *-*-* in $prog instead"
 380     }
 381
 382     set tmp [process-option $prog "execution test - " "an excess error failure" EXEC $text]
 383     if ![string match "" $tmp] then {
 384         set message [concat $message $tmp]
 385     }
 386
 387     set tmp [process-option $prog "excess errors test fails" "an excess error failure" EXCESSO $text]
 388     if ![string match "" $tmp] then {
 389         set excessbug_flag 1
 390         set message [concat $message $tmp]
 391         warning "please use excess errors test - XFAIL *-*-* in $prog instead"
 392     }
 393
 394     set tmp [process-option $prog "excess errors test - " "an excess error failure" EXCESS $text]
 395     if ![string match "" $tmp] then {
 396         set message [concat $message $tmp]
 397     }
 398
 399     set expect_crash \
 400       [process-option $prog "crash test - " "a crash" CRASH $text]
 401     if {$expect_crash != ""
 402         && [lindex [lindex $expect_crash 0] 1] == "XCRASH"} then {
 403        set expect_crash 1
 404     } else {
 405        set expect_crash 0
 406     }
 407
 408 #
 409 #  run the compiler and analyze the results
 410 #
 411
 412     # Since we don't check return status of the compiler, make sure
 413     # we can't run a.out when the compilation fails.
 414     remote_file build delete $output
 415     set comp_output [${tool}_target_compile $prog $output $compile_type $cflags]
 416     if { $runflag == 2 && [file exists $output] } then {
 417         set runflag 0
 418         set comp_output [concat $comp_output [${tool}_target_compile $output $final_output "executable" $cflags]]
 419         set output $final_output
 420     }
 421
 422     # Delete things like "ld.so: warning" messages.
 423     set comp_output [prune_warnings $comp_output]
 424
 425     if [regexp "Internal (compiler )?error" $comp_output] then {
 426         if $expect_crash then {
 427             setup_xfail "*-*-*"
 428         }
 429         fail "$name caused compiler crash"
 430         remote_file build delete $output
 431         return 1
 432     }
 433
 434     #send_user "\nold_dejagnu.exp: comp_output1 = :$comp_output:\n\n"
 435     #send_user "\nold_dejagnu.exp: message = :$message:\n\n"
 436     #send_user "\nold_dejagnu.exp: message length = [llength $message]\n\n"
 437
 438     set last_line 0
 439     foreach i $message {
 440
 441         #send_user "\nold_dejagnu.exp: i = :$i:\n\n"
 442
 443         # Remove all error messages for the line [lindex $i 0]
 444         # in the source file.  If we find any, success!
 445         set line [lindex $i 0]
 446         set pattern [lindex $i 2]
 447
 448         # Multiple tests one one line don't work, because we remove all
 449         # messages on the line for the first test.  So skip later ones.
 450         if { $line == $last_line } {
 451             continue
 452         }
 453         set last_line $line
 454
 455         if [regsub -all "(^|\n)\[^\n\]+:$line:\[^\n\]*" $comp_output "" comp_output] {
 456             set comp_output [string trimleft $comp_output]
 457             set ok pass
 458             set uhoh fail
 459         } else {
 460             set ok fail
 461             set uhoh pass
 462         }
 463
 464         case [lindex $i 1] {
 465             "ERROR" {
 466                 $ok "$name $pattern (test for errors, line $line)"
 467             }
 468             "XERROR" {
 469                 x$ok "$name $pattern (test for errors, line $line)"
 470             }
 471             "WARNING" {
 472                 $ok "$name $pattern (test for warnings, line $line)"
 473             }
 474             "XWARNING" {
 475                 x$ok "$name $pattern (test for warnings, line $line)"
 476             }
 477             "BOGUS" {
 478                 $uhoh "$name $pattern (test for bogus messages, line $line)"
 479             }
 480             "XBOGUS" {
 481                 x$uhoh "$name $pattern (test for bogus messages, line $line)"
 482             }
 483             "ABORT" {
 484                 $uhoh "$name $pattern (test for compiler aborts, line $line)"
 485             }
 486             "XABORT" {
 487                 x$uhoh "$name $pattern (test for compiler aborts, line $line)"
 488             }
 489             "SEGFAULT" {
 490                 $uhoh "$name $pattern (test for compiler segfaults, line $line)"
 491             }
 492             "XSEGFAULT" {
 493                 x$uhoh "$name $pattern (test for compiler segfaults, line $line)"
 494             }
 495             "LINKER" {
 496                 $uhoh "$name $pattern (test for linker problems, line $line)"
 497             }
 498             "XLINKER" {
 499                 x$uhoh "$name $pattern (test for linker problems, line $line)"
 500             }
 501             "BADC" {
 502                 $uhoh "$name $pattern (test for Bad C code, line $line)"
 503             }
 504             "XBADC" {
 505                 x$uhoh "$name $pattern (test for Bad C code, line $line)"
 506             }
 507             "BADASM" {
 508                 $uhoh "$name $pattern (test for bad assembler, line $line)"
 509             }
 510             "XBADASM" {
 511                 x$uhoh "$name $pattern (test for bad assembler, line $line)"
 512             }
 513             "XEXEC" {
 514                 set execbug_flag 1
 515             }
 516             "XEXCESS" {
 517                 set excessbug_flag 1
 518             }
 519         }
 520         #send_user "\nold_dejagnu.exp: comp_output2= :$comp_output:\n\n"
 521     }
 522     #send_user "\nold_dejagnu.exp: comp_output3 = :$comp_output:\n\n"
 523
 524     #look to see if this is all thats left, if so, all messages have been handled
 525     #send_user "comp_output: $comp_output\n"
 526     regsub -all "(^|\n)\[^\n\]*: In (\[^\n\]*function|method|\[^\n\]*structor) \[^\n\]*" $comp_output "" comp_output
 527     regsub -all "(^|\n)\[^\n\]*: In instantiation of \[^\n\]*" $comp_output "" comp_output
 528     regsub -all "(^|\n)\[^\n\]*:   instantiated from \[^\n\]*" $comp_output "" comp_output
 529     regsub -all "(^|\n)\[^\n\]*: At (top level|global scope):\[^\n\]*" $comp_output "" comp_output
 530     regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $comp_output "" comp_output
 531     regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $comp_output "" comp_output
 532     regsub -all "(^|\n)collect: re(compiling|linking)\[^\n\]*" $comp_output "" comp_output
 533
 534     set unsupported_message [${tool}_check_unsupported_p $comp_output]
 535     if { $unsupported_message != "" } {
 536         unsupported "$name: $unsupported_message"
 537         return
 538     }
 539
 540     # someone forgot to delete the extra lines
 541     regsub -all "\n+" $comp_output "\n" comp_output
 542     regsub "^\n+" $comp_output "" comp_output
 543     #send_user "comp_output: $comp_output\n"
 544
 545     # excess errors
 546     if $excessbug_flag then {
 547         setup_xfail "*-*-*"
 548     }
 549     if ![string match "" $comp_output] then {
 550         fail "$name (test for excess errors)"
 551         send_log "$comp_output\n"
 552     } else {
 553         pass "$name (test for excess errors)"
 554     }
 555
 556     # run the executable image
 557     if $runflag then {
 558         set executable $output
 559         if ![file exists $executable] then {
 560             # Since we couldn't run it, we consider it an expected failure,
 561             # so that test cases don't appear to disappear, and reappear.
 562             setup_xfail "*-*-*"
 563             fail "$name $pattern Execution test"
 564         } else {
 565             set status -1
 566             set result [eval [format "%s_load %s" $tool $executable]]
 567             set status [lindex $result 0];
 568             set output [lindex $result 1];
 569             if { $status == "pass" } {
 570                 remote_file build delete $executable;
 571             }
 572             if { $execbug_flag || $excessbug_flag } then {
 573                 setup_xfail "*-*-*"
 574             }
 575             $status "$name $pattern Execution test"
 576         }
 577     } else {
 578       verbose "deleting $output"
 579       remote_file build delete $output
 580     }
 581
 582     return 0
 583 }