libstdc++-v3/testsuite/lib/libstdc++.exp

   1 # Copyright (C) 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, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  16
  17 # Please email any bugs, comments, and/or additions to this file to:
  18 # libstdc++@gcc.gnu.org
  19 #
  20 # This file is contributed by Gabriel Dos Reis <gdr@codesourcery.com>
  21
  22 ## This file contains support routines for dg.exp based testsuite
  23 ## framework.
  24
  25 ## The global associative array lib_env contains the totality
  26 ## of options necessary to run testcases; the meanings of which are
  27 ## as follows:
  28 ##    lib_env(CXX)              The compiler used to run testcases.
  29 ##    lib_env(CXXFLAGS)         Special flags passed to the compiler.
  30 ##    lib_env(INCLUDES)         Includes options to pass to the compiler.
  31 ##    lib_env(LDFLAGS)          Additional library flags.
  32 ##    lib_env(LIBTOOL)          Path to the `libtool' script.
  33 ##    lib_env(SRC_DIR)          Where V3 master source lives.
  34 ##    lib_env(BUILD_DIR)        Where V3 is built.
  35 ##    lib_env(static)           Flags to pass to the linker to build a
  36 ##                              statically linked executable.
  37 ##    lib_env(shared)           Flags to pass to the linker to build a
  38 ##                              dynamically linked executable.
  39 ##    lib_env(testcase_options) Options specified by current testcase.
  40 ##                              These are specified through the @xxx@-keywords.
  41
  42
  43 load_lib dg.exp
  44
  45 ## Initialization routine.
  46 proc libstdc++-dg-init { args } {
  47     global lib_env
  48     global srcdir
  49     global outdir
  50     global dg-do-what-default
  51
  52     # By default, we assume we want to run program images.
  53     set dg-do-what-default run
  54
  55     # Get the source and the build directories.
  56     set src-dir [lookfor_file $srcdir libstdc++-v3]
  57     set build-dir [lookfor_file $outdir libstdc++-v3]
  58
  59     # Set proper environment variables for the framework.
  60     libstdc++-setup-flags ${src-dir} ${build-dir}
  61
  62     # mkcheck.in used to output these information.
  63     set output [remote_exec host $lib_env(CXX) -v]
  64 # XXX don't try clever formatting hacks at the moment
  65 #    if { [lindex $output 0] == 0 } {
  66 #       set output [lindex $output 1]
  67 #       regexp "gcc version.*$" $output version
  68 #       regsub "\n+" $version "" version
  69 #       clone_output "Compiler: $version"
  70 #       clone_output "Compiler flags: $lib_env(CXXFLAGS)"
  71 #    } else {
  72 #       perror "Cannot determine compiler version: [lindex $output 1]"
  73 #    }
  74 }
  75
  76 ## dg.exp callback.  Called from dg-test to run PROGRAM.
  77 ##
  78 ## This is the heart of the framework.  For the time being, it is
  79 ## pretty much baroque, but it will improve as time goes.
  80 proc libstdc++_load { prog } {
  81     global lib_env
  82     set opts $lib_env(testcase_options)
  83     set results [remote_load target $lib_env(LIBTOOL) "--mode=execute $prog"]
  84
  85     if { [lindex $results 0] == "pass" && [info exists opts(diff)] } {
  86         # FIXME: We should first test for any mentioned @output@ file here
  87         #        before taking any other action.
  88
  89         set firsts [glob -nocomplain [lindex $opts(diff) 0]]
  90         set seconds [glob -nocomplain [lindex $opts(diff) 1]]
  91         foreach f $firsts s $seconds {
  92             if { [diff $f $s] == 0 } {
  93                 # FIXME: Well we should report a message.  But for the time
  94                 #        being, just pretend there is nothing much to say.
  95                 #        Yes, that is silly, I know.  But we need, first, to
  96                 #        to have a working framework.
  97                 break
  98             }
  99         }
 100     }
 101     return $results
 102 }
 103
 104 ## Nothing particular to do.
 105 proc libstdc++_exit { } {
 106 }
 107
 108 ## Output the version of the libs tested.
 109 proc libstdc++_version { } {
 110     global lib_env
 111     set version "undeterminated"
 112
 113     # This file contains the library configuration, built at configure time.
 114     set config-file $lib_env(BUILD_DIR)/include/bits/c++config.h
 115
 116     set version_pattern "__GLIBCPP__\[ \t\]\+\[0-9\]\+"
 117     if [file exists ${config-file}] {
 118         set version [grep ${config-file} $version_pattern]
 119         regexp "\[0-9\]\+" $version version
 120     }
 121     clone_output "$lib_env(SRC_DIR) version $version"
 122     return 0
 123 }
 124
 125 ## Main loop.  Loop over TEST-DIRECTORIES and run each testcase
 126 ## found therein.
 127 proc libstdc++_runtest { testdirs } {
 128     global runtests
 129     global srcdir
 130     global outdir
 131
 132     set top-tests-dir [pwd]
 133     foreach d $testdirs {
 134         set testfiles [glob -nocomplain $d/*.C $d/*.cc]
 135         if { [llength $testfiles] == 0 } {
 136             continue
 137         }
 138
 139         # Make the appropriate test-dirs with related .libs/ subdir
 140         # to keep libtool happy.
 141         set td "$outdir/[dg-trim-dirname $srcdir $d]"
 142         maybe-make-directory $td
 143         maybe-make-directory $td/.libs
 144
 145         cd $td;
 146         foreach testfile $testfiles {
 147             # If we're not supposed to test this file, just skip it.
 148             if ![runtest_file_p $runtests $testfile] {
 149                 continue
 150             }
 151
 152 #           verbose "Testing [dg-trim-dirname $srcdir $testfile]"
 153             libstdc++_do_test $testfile static
 154             libstdc++_do_test $testfile shared
 155         }
 156         cd ${top-tests-dir}
 157     }
 158 }
 159
 160 ## dg.exp callback.  Main test-running routine.  Called from
 161 ## dg-test.
 162 ##
 163 ## TESTCASE is the file-name of the program to test;
 164 ## COMPILE_TYPE is the kind of compilation to apply to TESTCASE;
 165 ##              current compilation kinds are: preprocess, compile,
 166 ##              assemble, link, run.
 167 proc libstdc++-dg-test { testfile compile_type additional-options } {
 168     global srcdir; global outdir
 169     global lib_env
 170     global which_library
 171
 172     # Prepare for compilation output
 173     set comp_output ""
 174
 175     # By default, we want to use libtool to compile and run tests.
 176     set lt $lib_env(LIBTOOL)
 177     set lt_args "--tag=CXX"
 178
 179     libstdc++-process-options $testfile
 180     set output_file [file rootname [file tail $testfile]]
 181     switch $compile_type {
 182         "preprocess" {
 183             set lt $lib_env(CXX)
 184             set lt_args "-E $lib_env(INCLUDES) $testfile -o $output_file.ii"
 185         }
 186         "compile" {
 187             set lt $lib_env(CXX)
 188             set lt_args "-S $lib_env(INCLUDES) $testfile -o $output_file.s"
 189         }
 190         "assemble" {
 191             append lt_args " --mode=compile $lib_env(FLAGS) $testfile"
 192         }
 193         "run" -
 194         "link" {
 195             # If we're asked to run a testcase, then just do a `link'.
 196             # Later, the framework will load the program image through
 197             # libstdc++_load callback.
 198             if { $which_library == "static" } {
 199                 append output_file ".st-exe"
 200             } else {
 201                 append output_file ".sh-exe"
 202             }
 203             append lt_args " --mode=link $lib_env(FLAGS) \
 204                     $lib_env($which_library) $testfile \
 205                     -o $output_file $lib_env(LDFLAGS)"
 206         }
 207         default {
 208             perror "$compile_type: option not recognized"
 209         }
 210     }
 211
 212     set results [remote_exec host $lt "$lt_args ${additional-options}"]
 213     if { [lindex $results 0] != 0 } {
 214         set comp_output [lindex $results 1];
 215     }
 216     return [list $comp_output $output_file]
 217 }
 218
 219 ## Get options necessary to properly run testcases.
 220 ## SRC-DIR is the library top source directory e.g. something like
 221 ##         /codesourcery/egcs/libstdc++
 222 ## BUILD-DIR is top build directory e.g. something like
 223 ##           /tmp/egcs/i686-pc-linux-gnu/libstdc++
 224 proc libstdc++-setup-flags {src-dir build-dir} {
 225     global lib_env
 226
 227     set tmp [remote_exec host ${build-dir}/tests_flags "--built-library ${build-dir} ${src-dir}"]
 228     set status [lindex $tmp 0]
 229     set output [lindex $tmp 1]
 230     if { $status == 0 } {
 231         set flags [split $output :]
 232         set lib_env(BUILD_DIR) [lindex $flags 0]
 233         set lib_env(SRC_DIR) [lindex $flags 1]
 234         set lib_env(CXX) [lindex $flags 3]
 235         set lib_env(CXXFLAGS) [lindex $flags 4]
 236         set lib_env(INCLUDES) [lindex $flags 5]
 237         set lib_env(LDFLAGS) [lindex $flags 6]
 238
 239         # This is really really fragile.  We should find a better away to
 240         # tell the framework which flags to use for static/shared libraries.
 241         set lib_env(static) "-static"
 242         set lib_env(shared) ""
 243
 244         set lib_env(LIBTOOL) "$lib_env(BUILD_DIR)/libtool"
 245         set lib_env(FLAGS) "$lib_env(CXX) \
 246                 $lib_env(INCLUDES) $lib_env(CXXFLAGS)"
 247     } else {
 248         perror "$output"
 249     }
 250 }
 251
 252 proc maybe-make-directory {dir} {
 253     if {![file isdirectory $dir]} {
 254         file mkdir $dir
 255     }
 256 }
 257
 258 proc libstdc++_do_test { testfile lib } {
 259     global which_library; set which_library $lib
 260     ## Is it planed to handle -keep-output throught @xxx@-option
 261     dg-test -keep-output $testfile "" ""
 262 }
 263
 264 ## Process @xxx@ options.
 265 proc libstdc++-process-options { testfile } {
 266     global lib_env
 267
 268     array set opts { diff {} output {} require {} }
 269     set percent [file rootname [file tail $testfile]]
 270     set option-pattern "@.*@.*"
 271     set results [grep $testfile ${option-pattern}]
 272
 273     if ![string match "" $results] {
 274         foreach o $results {
 275             regexp "@(.*)@(.*)" $o o key value
 276             regsub -all "%" $value "$percent" value
 277
 278             # Not yet supported: keep-output, output, link-against
 279             switch $key {
 280                 "diff" -
 281                 "keep-output" -
 282                 "link-against" -
 283                 "output" -
 284                 "require" { }
 285                 default {
 286                     perror "libstdc++: Invalid option-specification `$o'"
 287                 }
 288             }
 289             set opts($key) $value
 290             unset key value
 291         }
 292     }
 293     set lib_env(testcase_options) [array get opts]
 294
 295     # copy any required data files.
 296     if ![string match "" $opts(require)] {
 297         set src [file dirname $testfile]
 298         set dst [pwd]
 299         foreach f $opts(require) {
 300             foreach t [glob -nocomplain "$src/$f"] {
 301                 file copy -force $t $dst
 302             }
 303         }
 304     }
 305 }
 306
 307 ###
 308 ### The following is an abominable hack, non-commendable software practice.
 309 ### This is supposed to be a very-very short term solution.
 310 ### Please, do not add any piece of code without my approval.
 311 ### -- Gaby
 312 ###
 313
 314 # dg-test -- runs a new style DejaGnu test
 315 #
 316 # Syntax: dg-test [-keep-output] prog tool_flags default_extra_tool_flags
 317 #
 318 # PROG is the full path name of the file to pass to the tool (eg: compiler).
 319 # TOOL_FLAGS is a set of options to always pass.
 320 # DEFAULT_EXTRA_TOOL_FLAGS are additional options if the testcase has none.
 321
 322 #proc dg-test { prog tool_flags default_extra_tool_flags } {
 323 proc dg-test { args } {
 324     global dg-do-what-default dg-interpreter-batch-mode dg-linenum-format
 325     global errorCode errorInfo
 326     global tool
 327     global srcdir               ;# eg: /calvin/dje/devo/gcc/./testsuite/
 328     global host_triplet target_triplet
 329
 330     set keep 0
 331     set i 0
 332
 333     if { [string index [lindex $args 0] 0] == "-" } {
 334         for { set i 0 } { $i < [llength $args] } { incr i } {
 335             if { [lindex $args $i] == "--" } {
 336                 incr i
 337                 break
 338             } elseif { [lindex $args $i] == "-keep-output" } {
 339                 set keep 1
 340             } elseif { [string index [lindex $args $i] 0] == "-" } {
 341                 clone_output "ERROR: dg-test: illegal argument: [lindex $args $i]"
 342                 return
 343             } else {
 344                 break
 345             }
 346         }
 347     }
 348
 349     if { $i + 3 != [llength $args] } {
 350         clone_output "ERROR: dg-test: missing arguments in call"
 351         return
 352     }
 353     set prog [lindex $args $i]
 354     set tool_flags [lindex $args [expr $i + 1]]
 355     set default_extra_tool_flags [lindex $args [expr $i + 2]]
 356
 357     set text "\[- A-Za-z0-9\.\;\"\_\:\'\`\(\)\!\#\=\+\?\&\*]*"
 358
 359     set name [dg-trim-dirname $srcdir $prog]
 360     # If we couldn't rip $srcdir out of `prog' then just do the best we can.
 361     # The point is to reduce the unnecessary noise in the logs.  Don't strip
 362     # out too much because different testcases with the same name can confuse
 363     # `test-tool'.
 364     if [string match "/*" $name] {
 365         set name "[file tail [file dirname $prog]]/[file tail $prog]"
 366     }
 367
 368     # Process any embedded dg options in the testcase.
 369
 370     # Use "" for the second element of dg-do-what so we can tell if it's been
 371     # explicitly set to "S".
 372     set dg-do-what [list ${dg-do-what-default} "" P]
 373     set dg-excess-errors-flag 0
 374     set dg-messages ""
 375     set dg-extra-tool-flags $default_extra_tool_flags
 376     set dg-final-code ""
 377
 378     # `dg-output-text' is a list of two elements: pass/fail and text.
 379     # Leave second element off for now (indicates "don't perform test")
 380     set dg-output-text "P"
 381
 382     # Define our own "special function" `unknown' so we catch spelling errors.
 383     # But first rename the existing one so we can restore it afterwards.
 384     catch {rename dg-save-unknown ""}
 385     rename unknown dg-save-unknown
 386     proc unknown { args } {
 387         return -code error "unknown dg option: $args"
 388     }
 389
 390     set tmp [dg-get-options $prog]
 391     foreach op $tmp {
 392         verbose "Processing option: $op" 3
 393         set status [catch "$op" errmsg]
 394         if { $status != 0 } {
 395             if { 0 && [info exists errorInfo] } {
 396                 # This also prints a backtrace which will just confuse
 397                 # testcase writers, so it's disabled.
 398                 perror "$name: $errorInfo\n"
 399             } else {
 400                 perror "$name: $errmsg for \"$op\"\n"
 401             }
 402             # ??? The call to unresolved here is necessary to clear `errcnt'.
 403             # What we really need is a proc like perror that doesn't set errcnt.
 404             # It should also set exit_status to 1.
 405             unresolved "$name: $errmsg for \"$op\""
 406             return
 407         }
 408     }
 409
 410     # Restore normal error handling.
 411     rename unknown ""
 412     rename dg-save-unknown unknown
 413
 414     # If we're not supposed to try this test on this target, we're done.
 415     if { [lindex ${dg-do-what} 1] == "N" } {
 416         unsupported "$name"
 417         verbose "$name not supported on this target, skipping it" 3
 418         return
 419     }
 420
 421     # Run the tool and analyze the results.
 422     # The result of ${tool}-dg-test is in a bit of flux.
 423     # Currently it is the name of the output file (or "" if none).
 424     # If we need more than this it will grow into a list of things.
 425     # No intention is made (at this point) to preserve upward compatibility
 426     # (though at some point we'll have to).
 427
 428     set results [${tool}-dg-test $prog [lindex ${dg-do-what} 0] "$tool_flags ${dg-extra-tool-flags}"];
 429
 430     set comp_output [lindex $results 0];
 431     set output_file [lindex $results 1];
 432
 433     #send_user "\nold_dejagnu.exp: comp_output1 = :$comp_output:\n\n"
 434     #send_user "\nold_dejagnu.exp: message = :$message:\n\n"
 435     #send_user "\nold_dejagnu.exp: message length = [llength $message]\n\n"
 436
 437     foreach i ${dg-messages} {
 438         verbose "Scanning for message: $i" 4
 439
 440         # Remove all error messages for the line [lindex $i 0]
 441         # in the source file.  If we find any, success!
 442         set line [lindex $i 0]
 443         set pattern [lindex $i 2]
 444         set comment [lindex $i 3]
 445         #send_user "Before:\n$comp_output\n"
 446         if [regsub -all "(^|\n)(\[^\n\]+$line\[^\n\]*($pattern)\[^\n\]*\n?)+" $comp_output "\n" comp_output] {
 447             set comp_output [string trimleft $comp_output]
 448             set ok pass
 449             set uhoh fail
 450         } else {
 451             set ok fail
 452             set uhoh pass
 453         }
 454         #send_user "After:\n$comp_output\n"
 455
 456         # $line will either be a formatted line number or a number all by
 457         # itself.  Delete the formatting.
 458         scan $line ${dg-linenum-format} line
 459         switch [lindex $i 1] {
 460             "ERROR" {
 461                 $ok "$name $comment (test for errors, line $line), $tool_flags ${dg-extra-tool-flags}"
 462             }
 463             "XERROR" {
 464                 x$ok "$name $comment (test for errors, line $line), $tool_flags ${dg-extra-tool-flags}"
 465             }
 466             "WARNING" {
 467                 $ok "$name $comment (test for warnings, line $line), $tool_flags ${dg-extra-tool-flags}"
 468             }
 469             "XWARNING" {
 470                 x$ok "$name $comment (test for warnings, line $line), $tool_flags ${dg-extra-tool-flags}"
 471             }
 472             "BOGUS" {
 473                 $uhoh "$name $comment (test for bogus messages, line $line), $tool_flags ${dg-extra-tool-flags}"
 474             }
 475             "XBOGUS" {
 476                 x$uhoh "$name $comment (test for bogus messages, line $line), $tool_flags ${dg-extra-tool-flags}"
 477             }
 478             "BUILD" {
 479                 $uhoh "$name $comment (test for build failure, line $line), $tool_flags ${dg-extra-tool-flags}"
 480             }
 481             "XBUILD" {
 482                 x$uhoh "$name $comment (test for build failure, line $line), $tool_flags ${dg-extra-tool-flags}"
 483             }
 484             "EXEC" { }
 485             "XEXEC" { }
 486         }
 487         #send_user "\nold_dejagnu.exp: comp_output2= :$comp_output:\n\n"
 488     }
 489     #send_user "\nold_dejagnu.exp: comp_output3 = :$comp_output:\n\n"
 490
 491     # Remove messages from the tool that we can ignore.
 492     #send_user "comp_output: $comp_output\n"
 493     set comp_output [prune_warnings $comp_output]
 494
 495     if { [info proc ${tool}-dg-prune] != "" } {
 496         set comp_output [${tool}-dg-prune $target_triplet $comp_output]
 497         switch -glob $comp_output {
 498             "::untested::*" {
 499                 regsub "::untested::" $comp_output "" message
 500                 untested "$name: $message"
 501                 return
 502             }
 503             "::unresolved::*" {
 504                 regsub "::unresolved::" $comp_output "" message
 505                 unresolved "$name: $message"
 506                 return
 507             }
 508             "::unsupported::*" {
 509                 regsub "::unsupported::" $comp_output "" message
 510                 unsupported "$name: $message"
 511                 return
 512             }
 513         }
 514     }
 515
 516     # See if someone forgot to delete the extra lines.
 517     regsub -all "\n+" $comp_output "\n" comp_output
 518     regsub "^\n+" $comp_output "" comp_output
 519     #send_user "comp_output: $comp_output\n"
 520
 521     # Don't do this if we're testing an interpreter.
 522     # FIXME: why?
 523     if { ${dg-interpreter-batch-mode} == 0 } {
 524         # Catch excess errors (new bugs or incomplete testcases).
 525         if ${dg-excess-errors-flag} {
 526             setup_xfail "*-*-*"
 527         }
 528         if ![string match "" $comp_output] {
 529             fail "$name (test for excess errors), $tool_flags ${dg-extra-tool-flags}"
 530             send_log "Excess errors:\n$comp_output\n"
 531         } else {
 532             pass "$name (test for excess errors), $tool_flags ${dg-extra-tool-flags}"
 533         }
 534     }
 535
 536     # Run the executable image if asked to do so.
 537     # FIXME: This is the only place where we assume a standard meaning to
 538     # the `keyword' argument of dg-do.  This could be cleaned up.
 539     if { [lindex ${dg-do-what} 0] == "run" } {
 540         if ![file exists $output_file] {
 541             warning "$name compilation failed to produce executable"
 542         } else {
 543             set status -1
 544             set result [${tool}_load $output_file]
 545             set status [lindex $result 0];
 546             set output [lindex $result 1];
 547             #send_user "After exec, status: $status\n"
 548             if { [lindex ${dg-do-what} 2] == "F" } {
 549                 setup_xfail "*-*-*"
 550             }
 551             if { "$status" == "pass" } {
 552                 pass "$name (execution test), $tool_flags ${dg-extra-tool-flags}"
 553                 verbose "Exec succeeded." 3
 554                 if { [llength ${dg-output-text}] > 1 } {
 555                     #send_user "${dg-output-text}\n"
 556                     if { [lindex ${dg-output-text} 0] == "F" } {
 557                         setup_xfail "*-*-*"
 558                     }
 559                     set texttmp [lindex ${dg-output-text} 1]
 560                     if { ![regexp $texttmp ${output}] } {
 561                         fail "$name output pattern test, is ${output}, should match $texttmp"
 562                         verbose "Failed test for output pattern $texttmp" 3
 563                     } else {
 564                         pass "$name output pattern test, $texttmp"
 565                         verbose "Passed test for output pattern $texttmp" 3
 566                     }
 567                     unset texttmp
 568                 }
 569             } elseif { "$status" == "fail" } {
 570                 # It would be nice to get some info out of errorCode.
 571                 if [info exists errorCode] {
 572                     verbose "Exec failed, errorCode: $errorCode" 3
 573                 } else {
 574                     verbose "Exec failed, errorCode not defined!" 3
 575                 }
 576                 fail "$name (execution test), $tool_flags ${dg-extra-tool-flags}"
 577             } else {
 578                 $status "$name (execution test), $tool_flags ${dg-extra-tool-flags}"
 579             }
 580         }
 581     }
 582
 583     # Are there any further tests to perform?
 584     # Note that if the program has special run-time requirements, running
 585     # of the program can be delayed until here.  Ditto for other situations.
 586     # It would be a bit cumbersome though.
 587
 588     if ![string match ${dg-final-code} ""] {
 589         regsub -all "\\\\(\[{}\])" ${dg-final-code} "\\1" dg-final-code
 590         # Note that the use of `args' here makes this a varargs proc.
 591         proc dg-final-proc { args } ${dg-final-code}
 592         verbose "Running dg-final tests." 3
 593         verbose "dg-final-proc:\n[info body dg-final-proc]" 4
 594         if [catch "dg-final-proc $prog" errmsg] {
 595             perror "$name: error executing dg-final: $errmsg"
 596             # ??? The call to unresolved here is necessary to clear `errcnt'.
 597             # What we really need is a proc like perror that doesn't set errcnt.
 598             # It should also set exit_status to 1.
 599             unresolved "$name: error executing dg-final: $errmsg"
 600         }
 601     }
 602
 603     # Do some final clean up.
 604     # When testing an interpreter, we don't compile something and leave an
 605     # output file.
 606     if { ! ${keep} && ${dg-interpreter-batch-mode} == 0 } {
 607         catch "exec rm -f $output_file"
 608     }
 609 }