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 46proc 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 104proc 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 111proc 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 133proc 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 set to_download "" 209 210 regsub -all "\n\[^\n\]+(\n|$)" $tmp "\n" tmp 211 set tmp [string trim $tmp] 212 if ![string match "" $tmp] then { 213 regsub "^.*Special.*Options:" $tmp "" tmp 214 lappend cflags "additional_flags=$tmp" 215 verbose "Adding special options $tmp" 2 216 } else { 217 lappend cflags "additional_flags=$default_cflags" 218 } 219 220 if { $cflagsx != "" } { 221 lappend cflags "additional_flags=$cflagsx" 222 } 223 224 set tmp [lindex [grep $prog "Additional sources: .*"] 0] 225 regsub -all "\n\[^\n\]+(\n|$)" $tmp "\n" tmp 226 set tmp [string trim $tmp] 227 if ![string match "" $tmp] then { 228 regsub "^.*Additional.*sources:" $tmp "" tmp 229 if [is_remote host] { 230 lappend cflags "additional_flags=$tmp" 231 } 232 regsub -all " " $tmp " [file dirname $prog]/" tmp 233 if ![is_remote host] { 234 lappend cflags "additional_flags=$tmp" 235 } 236 set to_download [concat $to_download $tmp] 237 verbose "Adding sources $tmp" 238 } 239 240 set tmp [lindex [grep $prog "Additional files: .*"] 0] 241 regsub -all "\n\[^\n\]+(\n|$)" $tmp "\n" tmp 242 set tmp [string trim $tmp] 243 if ![string match "" $tmp] then { 244 regsub "^.*Additional.*files:" $tmp "" tmp 245 regsub -all " " $tmp " [file dirname $prog]/" tmp 246 set to_download [concat $to_download $tmp] 247 verbose "Downloading files $tmp" 248 } 249 250 lappend cflags "compiler=$compiler" 251 252 regsub -all "\[./\]" "$name" "-" output; 253 set output "$tmpdir/$output.exe"; 254 set compile_type "executable" 255 256 set tmp [lindex [grep $prog "Build don.t link:"] 0] 257 if ![string match "" $tmp] then { 258 set compile_type "object" 259 set runflag 0 260 set output "$tmpdir/[file tail [file rootname $prog]].o" 261 verbose "Will compile $prog to object" 3 262 } 263 264 set tmp [lindex [grep $prog "Build then link:"] 0] 265 if ![string match "" $tmp] then { 266 set compile_type "object" 267 set runflag 2 268 set final_output "$output" 269 set output "$tmpdir/[file tail [file rootname $prog]].o" 270 verbose "Will compile $prog to object, then link it" 3 271 } 272 273 set tmp [lindex [grep $prog "Build don.t run:"] 0] 274 if ![string match "" $tmp] then { 275 set runflag 0 276 verbose "Will compile $prog to binary" 3 277 } 278 279 set tmp [grep $prog "Skip if (|not )feature:.*"]; 280 if { $tmp != "" } { 281 foreach line $tmp { 282 if [regexp "Skip if not feature" $line] { 283 set not 1; 284 } else { 285 set not 0; 286 } 287 regsub "^.*Skip if (|not )feature:\[ \]*" "$line" "" i; 288 set is_set 0; 289 foreach j $i { 290 if [target_info exists $j] { 291 set is_set 1; 292 break; 293 } 294 } 295 if { $is_set != $not } { 296 untested "$name: Test skipped: ${line}($j set)" 297 return; 298 } 299 } 300 } 301 302 set tmp [grep $prog "Skip if (|not )target:.*"]; 303 if { $tmp != "" } { 304 foreach line $tmp { 305 if [regexp "Skip if not target:" $line] { 306 set not 1; 307 } else { 308 set not 0; 309 } 310 regsub "^.*Skip if (|not )target:\[ \]*" "$line" "" i; 311 set ist 0; 312 foreach j $i { 313 if [istarget $j] { 314 set ist 1; 315 break; 316 } 317 } 318 if { $ist != $not } { 319 untested "$name: Test skipped: ${line}" 320 return; 321 } 322 } 323 } 324 325 if ![isnative] { 326 set tmp [lindex [grep $prog "Skip if not native"] 0]; 327 if { $tmp != "" } { 328 untested "$name: Test skipped because not native"; 329 return; 330 } 331 } else { 332 set tmp [lindex [grep $prog "Skip if native"] 0]; 333 if { $tmp != "" } { 334 untested "$name: Test skipped because native"; 335 return; 336 } 337 } 338 339 lappend cflags "libs=$libs" 340 341# 342# Look for the other keywords and extract the error messages. 343# `message' contains all the things we found. 344# ??? We'd like to use lappend below instead of concat, but that doesn't 345# work (adds an extra level of nesting to $tmp). 346# 347 348 set message "" 349 350 set tmp [process-option $prog "ERROR - " "an error message" ERROR "$text error$text"] 351 if ![string match "" $tmp] then { 352 set runflag 0 353 set message [concat $message $tmp] 354 } 355 356 set tmp [process-option $prog "WARNING - " "a warning message" WARNING "warning"] 357 if ![string match "" $tmp] then { 358 set runflag 0 359 set message [concat $message $tmp] 360 } 361 362 set tmp [process-option $prog "gets bogus error" "a bogus error" BOGUS $text] 363 if ![string match "" $tmp] then { 364 set message [concat $message $tmp] 365 } 366 367 set tmp [process-option $prog "causes invalid C code" "a bad C translation" BADC $text] 368 if ![string match "" $tmp] then { 369 set message [concat $message $tmp] 370 } 371 372 set tmp [process-option $prog "invalid assembly code" "some invalid assembly code" BADASM $text] 373 if ![string match "" $tmp] then { 374 set message [concat $message $tmp] 375 } 376 377 set tmp [process-option $prog "causes abort" "an abort cause" ABORT $text] 378 if ![string match "" $tmp] then { 379 set message [concat $message $tmp] 380 } 381 382 set tmp [process-option $prog "causes segfault" "a segfault cause" SEGFAULT $text] 383 if ![string match "" $tmp] then { 384 set message [concat $message $tmp] 385 } 386 387 set tmp [process-option $prog "causes linker error" "a linker error" LINKER $text] 388 if ![string match "" $tmp] then { 389 set message [concat $message $tmp] 390 } 391 392 set tmp [process-option $prog "execution test fails" "an execution failure" EXECO $text] 393 if ![string match "" $tmp] then { 394 set execbug_flag 1 395 set message [concat $message $tmp] 396 warning "please use execution test - XFAIL *-*-* in $prog instead" 397 } 398 399 set tmp [process-option $prog "execution test - " "an excess error failure" EXEC $text] 400 if ![string match "" $tmp] then { 401 set message [concat $message $tmp] 402 } 403 404 set tmp [process-option $prog "excess errors test fails" "an excess error failure" EXCESSO $text] 405 if ![string match "" $tmp] then { 406 set excessbug_flag 1 407 set message [concat $message $tmp] 408 warning "please use excess errors test - XFAIL *-*-* in $prog instead" 409 } 410 411 set tmp [process-option $prog "excess errors test - " "an excess error failure" EXCESS $text] 412 if ![string match "" $tmp] then { 413 set message [concat $message $tmp] 414 } 415 416 set expect_crash \ 417 [process-option $prog "crash test - " "a crash" CRASH $text] 418 if {$expect_crash != "" 419 && [lindex [lindex $expect_crash 0] 1] == "XCRASH"} then { 420 set expect_crash 1 421 } else { 422 set expect_crash 0 423 } 424 425# 426# run the compiler and analyze the results 427# 428 # Download any source or header files we might need. 429 if [is_remote host] { 430 foreach file $to_download { 431 remote_download host $file 432 } 433 } 434 435 # Since we don't check return status of the compiler, make sure 436 # we can't run a.out when the compilation fails. 437 remote_file build delete $output 438 set comp_output [${tool}_target_compile $prog $output $compile_type $cflags] 439 if { $runflag == 2 && [file exists $output] } then { 440 set runflag 0 441 set comp_output [concat $comp_output [${tool}_target_compile $output $final_output "executable" $cflags]] 442 set output $final_output 443 } 444 445 # Delete things like "ld.so: warning" messages. 446 set comp_output [prune_gcc_output [prune_warnings $comp_output]] 447 448 if [regexp "\[Ii\]nternal (compiler )?error" $comp_output] then { 449 if $expect_crash then { 450 setup_xfail "*-*-*" 451 } 452 fail "$name caused compiler crash" 453 remote_file build delete $output 454 return 1 455 } 456 457 #send_user "\nold_dejagnu.exp: comp_output1 = :$comp_output:\n\n" 458 #send_user "\nold_dejagnu.exp: message = :$message:\n\n" 459 #send_user "\nold_dejagnu.exp: message length = [llength $message]\n\n" 460 461 set last_line 0 462 foreach i $message { 463 464 #send_user "\nold_dejagnu.exp: i = :$i:\n\n" 465 466 # Remove all error messages for the line [lindex $i 0] 467 # in the source file. If we find any, success! 468 set line [lindex $i 0] 469 set pattern [lindex $i 2] 470 471 # Multiple tests one one line don't work, because we remove all 472 # messages on the line for the first test. So skip later ones. 473 if { $line == $last_line } { 474 continue 475 } 476 set last_line $line 477 478 if [regsub -all "(^|\n)\[^\n\]+:$line:\[^\n\]*" $comp_output "" comp_output] { 479 set comp_output [string trimleft $comp_output] 480 set ok pass 481 set uhoh fail 482 } else { 483 set ok fail 484 set uhoh pass 485 } 486 487 case [lindex $i 1] { 488 "ERROR" { 489 $ok "$name $pattern (test for errors, line $line)" 490 } 491 "XERROR" { 492 x$ok "$name $pattern (test for errors, line $line)" 493 } 494 "WARNING" { 495 $ok "$name $pattern (test for warnings, line $line)" 496 } 497 "XWARNING" { 498 x$ok "$name $pattern (test for warnings, line $line)" 499 } 500 "BOGUS" { 501 $uhoh "$name $pattern (test for bogus messages, line $line)" 502 } 503 "XBOGUS" { 504 x$uhoh "$name $pattern (test for bogus messages, line $line)" 505 } 506 "ABORT" { 507 $uhoh "$name $pattern (test for compiler aborts, line $line)" 508 } 509 "XABORT" { 510 x$uhoh "$name $pattern (test for compiler aborts, line $line)" 511 } 512 "SEGFAULT" { 513 $uhoh "$name $pattern (test for compiler segfaults, line $line)" 514 } 515 "XSEGFAULT" { 516 x$uhoh "$name $pattern (test for compiler segfaults, line $line)" 517 } 518 "LINKER" { 519 $uhoh "$name $pattern (test for linker problems, line $line)" 520 } 521 "XLINKER" { 522 x$uhoh "$name $pattern (test for linker problems, line $line)" 523 } 524 "BADC" { 525 $uhoh "$name $pattern (test for Bad C code, line $line)" 526 } 527 "XBADC" { 528 x$uhoh "$name $pattern (test for Bad C code, line $line)" 529 } 530 "BADASM" { 531 $uhoh "$name $pattern (test for bad assembler, line $line)" 532 } 533 "XBADASM" { 534 x$uhoh "$name $pattern (test for bad assembler, line $line)" 535 } 536 "XEXEC" { 537 set execbug_flag 1 538 } 539 "XEXCESS" { 540 set excessbug_flag 1 541 } 542 } 543 #send_user "\nold_dejagnu.exp: comp_output2= :$comp_output:\n\n" 544 } 545 #send_user "\nold_dejagnu.exp: comp_output3 = :$comp_output:\n\n" 546 547 #look to see if this is all thats left, if so, all messages have been handled 548 #send_user "comp_output: $comp_output\n" 549 regsub -all "(^|\n)\[^\n\]*: In (\[^\n\]*function|method|\[^\n\]*structor) \[^\n\]*" $comp_output "" comp_output 550 regsub -all "(^|\n)\[^\n\]*: In instantiation of \[^\n\]*" $comp_output "" comp_output 551 regsub -all "(^|\n)\[^\n\]*: instantiated from \[^\n\]*" $comp_output "" comp_output 552 regsub -all "(^|\n)\[^\n\]*: At (top level|global scope):\[^\n\]*" $comp_output "" comp_output 553 regsub -all "(^|\n)\[^\n\]*file path prefix \[^\n\]* never used" $comp_output "" comp_output 554 regsub -all "(^|\n)\[^\n\]*linker input file unused since linking not done" $comp_output "" comp_output 555 regsub -all "(^|\n)collect: re(compiling|linking)\[^\n\]*" $comp_output "" comp_output 556 557 set unsupported_message [${tool}_check_unsupported_p $comp_output] 558 if { $unsupported_message != "" } { 559 unsupported "$name: $unsupported_message" 560 return 561 } 562 563 # someone forgot to delete the extra lines 564 regsub -all "\n+" $comp_output "\n" comp_output 565 regsub "^\n+" $comp_output "" comp_output 566 #send_user "comp_output: $comp_output\n" 567 568 # excess errors 569 if $excessbug_flag then { 570 setup_xfail "*-*-*" 571 } 572 if ![string match "" $comp_output] then { 573 fail "$name (test for excess errors)" 574 send_log "$comp_output\n" 575 } else { 576 pass "$name (test for excess errors)" 577 } 578 579 # run the executable image 580 if $runflag then { 581 set executable $output 582 if ![file exists $executable] then { 583 # Since we couldn't run it, we consider it an expected failure, 584 # so that test cases don't appear to disappear, and reappear. 585 setup_xfail "*-*-*" 586 fail "$name $pattern Execution test" 587 } else { 588 set status -1 589 set result [eval [format "%s_load %s" $tool $executable]] 590 set status [lindex $result 0]; 591 set output [lindex $result 1]; 592 if { $status == "pass" } { 593 remote_file build delete $executable; 594 } 595 if { $execbug_flag || $excessbug_flag } then { 596 setup_xfail "*-*-*" 597 } 598 $status "$name $pattern Execution test" 599 } 600 } else { 601 verbose "deleting $output" 602 remote_file build delete $output 603 } 604 605 return 0 606} 607