sim/testsuite/lib/sim-defs.exp

   1 # Simulator dejagnu utilities.
   2 # TODO: Switch to using dg-xxx helpers rather than parsing the files directly.
   3
   4 # Communicate simulator path from sim_init to sim_version.
   5 # For some reason [board_info target sim] doesn't work in sim_version.
   6 # [Presumubly because the target has been "popped" by then.  Odd though.]
   7 set sim_path "unknown-run"
   8
   9 # Find the simulator arch.
  10
  11 proc sim_arch {} {
  12     global subdir
  13     set arch "$subdir"
  14     while { [file dirname $arch] != "." } {
  15         set arch [file dirname $arch]
  16     }
  17     return "$arch"
  18 }
  19
  20 # Initialize the testrun.
  21 #
  22 # Normally dejagnu will execute ${tool}_init automatically, but since we set
  23 # --tool '' (for a simpler testsuite/ layout), we have each test call this
  24 # itself.
  25
  26 proc sim_init { args } {
  27     global builddir
  28     global subdir
  29     global sim_path
  30
  31     # Find the path to the simulator for executing.
  32     set sim_path "$builddir/[sim_arch]/run"
  33
  34     # As gross as it is, we unset the linker script specified by the target
  35     # board.  The simulator board file mips-sim.exp, sets ldscript to the
  36     # MIPS libgloss linker scripts which include libgcc (and possibly other
  37     # libraries), which the linker (used to link these tests rather than the
  38     # compiler) can't necessarily find.  Similarly iq2000-sim.exp and
  39     # m68hc11-sim.exp.  So, we make it a common rule to clear the slate for
  40     # all simulators.
  41     unset_currtarget_info ldscript
  42
  43     sim_init_toolchain
  44
  45     # Need to return an empty string.  This tells dejagnu to *not* re-run us
  46     # with the exact test that we're about to run.
  47     return ""
  48 }
  49
  50 # Initialize the toolchain settings for this port.
  51 # Needs to be called once per-port.
  52
  53 proc sim_init_toolchain {} {
  54     global objdir
  55     global srcdir
  56     global cpu_option
  57     global cpu_option_sep
  58     global ASFLAGS_FOR_TARGET
  59     global CFLAGS_FOR_TARGET
  60     global LDFLAGS_FOR_TARGET
  61     global SIMFLAGS_FOR_TARGET
  62     global global_as_works
  63     global global_cpp_works
  64     global global_cc_works
  65     global global_cc_os
  66     global CFLAGS_FOR_TARGET_init
  67
  68     # Reset all the toolchain settings.  This provides a clean slate when
  69     # starting the next set of tests.
  70     set ASFLAGS_FOR_TARGET ""
  71     set CFLAGS_FOR_TARGET ""
  72     set LDFLAGS_FOR_TARGET ""
  73     set SIMFLAGS_FOR_TARGET ""
  74     unset -nocomplain cpu_option cpu_option_sep
  75
  76     # The configure script created XXX_FOR_TARGET_$ARCH for us, so merge those
  77     # into plain XXX_FOR_TARGET for this particular arch run.
  78     global SIM_PRIMARY_TARGET
  79     set arch [sim_arch]
  80     set ARCH [string map {- _} [string toupper $arch]]
  81     foreach var {AS LD CC} {
  82         set var_for_target "${var}_FOR_TARGET"
  83         global $var_for_target
  84         set var_for_target_arch "${var_for_target}_${ARCH}"
  85         global $var_for_target_arch
  86
  87         if [info exists $var_for_target_arch] {
  88             set $var_for_target [set $var_for_target_arch]
  89         } else {
  90             set $var_for_target ""
  91         }
  92
  93         if { [set $var_for_target] == "" } {
  94             # If building for the primary target, use the default settings.
  95             if { $arch == $SIM_PRIMARY_TARGET } {
  96                 unset -nocomplain $var_for_target
  97             } {
  98                 set $var_for_target false
  99             }
 100         }
 101     }
 102
 103     # See if an assembler is available.
 104     if { $arch != $SIM_PRIMARY_TARGET && $AS_FOR_TARGET == "false" } {
 105         verbose -log "Can't find a compatible assembler"
 106         set global_as_works 0
 107     } {
 108         verbose -log "Found a compatible assembler"
 109         set global_as_works 1
 110     }
 111
 112     # Merge per-test settings if available.
 113     if ![info exists CFLAGS_FOR_TARGET_init] {
 114         set CFLAGS_FOR_TARGET_init ""
 115     }
 116     set cc_options [list "additional_flags=$CFLAGS_FOR_TARGET_init"]
 117
 118     # See if we have a preprocessor available.
 119     set result [target_compile $srcdir/lib/compilercheck.c \
 120                 $objdir/compilercheck.x "preprocess" $cc_options]
 121     set global_cpp_works [string equal "" "$result"]
 122
 123     # See if we have a compiler available, and which environment it's targeting.
 124     set global_cc_os ""
 125     set global_cc_works 0
 126     if { $arch != $SIM_PRIMARY_TARGET && $CC_FOR_TARGET == "false" } {
 127         verbose -log "Can't find a compatible C compiler"
 128     } elseif { [target_compile $srcdir/lib/newlibcheck.c \
 129                 $objdir/compilercheck.x "executable" $cc_options] == "" } {
 130         verbose -log "Found newlib C compiler"
 131         set global_cc_works 1
 132         set global_cc_os "newlib"
 133     } elseif { [target_compile $srcdir/lib/linuxcheck.c \
 134                 $objdir/compilercheck.x "executable" $cc_options] == "" } {
 135         verbose -log "Found Linux C compiler"
 136         set global_cc_works 1
 137         set global_cc_os "linux"
 138     } elseif { [target_compile $srcdir/lib/compilercheck.c \
 139                 $objdir/compilercheck.x "executable" $cc_options] == "" } {
 140         verbose -log "Found C compiler, but unknown OS"
 141         set global_cc_works 1
 142     } {
 143         verbose -log "Can't execute C compiler"
 144     }
 145
 146     file delete $objdir/compilercheck.x
 147
 148     unset CFLAGS_FOR_TARGET_init
 149 }
 150
 151 # Print the version of the simulator being tested.
 152 # Required by dejagnu.
 153
 154 proc sim_version {} {
 155     global sim_path
 156     set version 0.5
 157     clone_output "$sim_path $version\n"
 158 }
 159
 160 # Run a program on the simulator.
 161 # Required by dejagnu (at least ${tool}_run used to be).
 162 #
 163 # SIM_OPTS are options for the simulator.
 164 # PROG_OPTS are options passed to the simulated program.
 165 # At present REDIR must be "" or "> foo".
 166 # OPTIONS is a list of options internal to this routine.
 167 # This is modelled after target_compile.  We want to be able to add new
 168 # options without having to update all our users.
 169 # Currently:
 170 #       env(foo)=val    - set environment variable foo to val for this run
 171 #       timeout=val     - set the timeout to val for this run
 172 #
 173 # The result is a list of two elements.
 174 # The first is the program's exit status (0/1/etc...).
 175 # The second is the program's output.
 176 #
 177 # This is different than the sim_load routine provided by
 178 # dejagnu/config/sim.exp.  It's not clear how to pass arguments to the
 179 # simulator (not the simulated program, the simulator) with sim_load.
 180
 181 proc sim_run { prog sim_opts prog_opts redir options } {
 182     global sim_path
 183
 184     # Set the default value of the timeout.
 185     # FIXME: The timeout value we actually want is a function of
 186     # host, target, and testcase.
 187     set testcase_timeout [board_info target sim_time_limit]
 188     if { "$testcase_timeout" == "" } {
 189         set testcase_timeout [board_info host testcase_timeout]
 190     }
 191     if { "$testcase_timeout" == "" } {
 192         set testcase_timeout 240 ;# 240 same as in dejagnu/config/sim.exp.
 193     }
 194
 195     # Initial the environment we pass to the testcase.
 196     set testcase_env ""
 197
 198     # Process OPTIONS ...
 199     foreach o $options {
 200         if [regexp {^env\((.*)\)=(.*)} $o full var val] {
 201             set testcase_env "$testcase_env $var=$val"
 202         } elseif [regexp {^timeout=(.*)} $o full val] {
 203             set testcase_timeout $val
 204         }
 205
 206     }
 207
 208     verbose "testcase timeout is set to $testcase_timeout" 1
 209
 210     set sim $sim_path
 211
 212     if [is_remote host] {
 213         set prog [remote_download host $prog]
 214         if { $prog == "" } {
 215             error "download failed"
 216             return -1
 217         }
 218     }
 219
 220     set board [target_info name]
 221     if [board_info $board exists sim,options] {
 222         set always_opts [board_info $board sim,options]
 223     } else {
 224         set always_opts ""
 225     }
 226
 227     # FIXME: this works for UNIX only
 228     if { "$testcase_env" != "" } {
 229         set sim "env $testcase_env $sim"
 230     }
 231
 232     if { [board_info target sim,protocol] == "sid" } {
 233         set cmd ""
 234         set sim_opts "$sim_opts -e \"set cpu-loader file [list ${prog}]\""
 235     } else {
 236         set cmd "$prog"
 237     }
 238
 239     send_log "$sim $always_opts $sim_opts $cmd $prog_opts\n"
 240
 241     if { "$redir" == "" } {
 242         remote_spawn host "$sim $always_opts $sim_opts $cmd $prog_opts"
 243     } else {
 244         remote_spawn host "$sim $always_opts $sim_opts $cmd $prog_opts $redir" writeonly
 245     }
 246     set result [remote_wait host $testcase_timeout]
 247
 248     set return_code [lindex $result 0]
 249     set output [lindex $result 1]
 250     # Remove the \r part of "\r\n" so we don't break all the patterns
 251     # we want to match.
 252     regsub -all -- "\r" $output "" output
 253
 254     if [is_remote host] {
 255         # clean up after ourselves.
 256         remote_file host delete $prog
 257     }
 258
 259     return [list $return_code $output]
 260 }
 261
 262 # Support function for "#requires: simoption <xx>":
 263 # Looks in "run --help" output for <xx>, returns 1 iff <xx> is mentioned
 264 # there and looks like an option name, otherwise 0.
 265
 266 proc sim_check_requires_simoption { optname } {
 267     global sim_path
 268     set testrun "$sim_path --help"
 269     verbose -log "Checking for simoption `$optname'" 3
 270     remote_spawn host $testrun
 271     set result [remote_wait host 240]
 272
 273     set return_code [lindex $result 0]
 274     if { $return_code != 0 } {
 275         perror "Can't execute `$testrun' to check for `$optname'"
 276         return 0
 277     }
 278
 279     set output [lindex $result 1]
 280     # Remove \r as for regular runs.
 281     regsub -all -- "\r" $output "" output
 282
 283     # The option output format for --help for each line where an
 284     # option name is mentioned, is assumed to be two space followed
 285     # by the option name followed by a space or left square bracket,
 286     # like in (optname=--foo): "  --foo " or "  --foo[this|that]".
 287     # Beware not to match "  --foo-bar" nor "  --foobar".
 288     if [string match "*\n  $optname\[\[ \]*" $output] {
 289         verbose -log "Found `$optname'" 3
 290         return 1
 291     }
 292     verbose -log "Did not find `$optname'" 3
 293
 294     return 0
 295 }
 296
 297 # Run testcase NAME.
 298 # NAME is either a fully specified file name, or just the file name in which
 299 # case $srcdir/$subdir will be prepended.
 300 # REQUESTED_MACHS is a list of machines to run the testcase on.  If NAME isn't
 301 # for the specified machine(s), it is ignored.
 302 # Typically REQUESTED_MACHS contains just one element, it is up to the caller
 303 # to iterate over the desired machine variants.
 304 #
 305 # The file can contain options in the form "# option(mach list): value".
 306 # Possibilities:
 307 # mach: [all | machine names]
 308 # as[(mach-list)]: <assembler options>
 309 # ld[(mach-list)]: <linker options>
 310 # cc[(mach-list)]: <compiler options>
 311 # sim[(mach-list)]: <simulator options>
 312 # progopts: <arguments to the program being simulated>
 313 # progos: OS required for the test
 314 # status: program exit status to treat as "pass"
 315 # output: program output pattern to match with string-match
 316 # xerror: program is expected to return with a "failure" exit code
 317 # xfail: <PRMS-opt> <target-triplets-where-test-fails>
 318 # kfail: <PRMS> <target-triplets-where-test-fails>
 319 # If `output' is not specified, the program must output "pass" if !xerror or
 320 # "fail" if xerror.
 321 # The parens in "optname()" are optional if the specification is for all machs.
 322 # Multiple "output", "xfail" and "kfail" options concatenate.
 323 # The xfail and kfail arguments are space-separated target triplets and PRIDs.
 324 # There must be a PRMS (bug report ID) specified for kfail, while it's
 325 # optional for xfail.
 326
 327 proc run_sim_test { name requested_machs } {
 328     global subdir srcdir objdir
 329     global sim_path
 330     global opts
 331     global cpu_option
 332     global cpu_option_sep
 333     global SIMFLAGS_FOR_TARGET
 334     global global_as_works
 335     global global_cpp_works
 336     global global_cc_works
 337     global global_cc_os
 338
 339     if ![file exists $sim_path] {
 340         unsupported "$name: missing simulator $sim_path"
 341         return
 342     }
 343
 344     if [string match "*/*" $name] {
 345         set file $name
 346         set name [file tail $name]
 347     } else {
 348         set file "$srcdir/$subdir/$name"
 349     }
 350
 351     set opt_array [slurp_options "${file}"]
 352     if { $opt_array == -1 } {
 353         unresolved $subdir/$name
 354         return
 355     }
 356     # Clear default options
 357     set opts(as) ""
 358     set opts(ld) ""
 359     set opts(cc) ""
 360     set opts(progopts) ""
 361     set opts(progos) ""
 362     set opts(requires) {}
 363     set opts(sim) ""
 364     set opts(status) "0"
 365     set opts(output) ""
 366     set opts(mach) ""
 367     set opts(timeout) ""
 368     set opts(xerror) "no"
 369     set opts(xfail) ""
 370     set opts(kfail) ""
 371     set seen_output 0
 372
 373     if ![info exists SIMFLAGS_FOR_TARGET] {
 374         set SIMFLAGS_FOR_TARGET ""
 375     }
 376
 377     # Clear any machine specific options specified in a previous test case
 378     foreach m $requested_machs {
 379         if [info exists opts(as,$m)] {
 380             unset opts(as,$m)
 381         }
 382         if [info exists opts(ld,$m)] {
 383             unset opts(ld,$m)
 384         }
 385         if [info exists opts(cc,$m)] {
 386             unset opts(cc,$m)
 387         }
 388         if [info exists opts(sim,$m)] {
 389             unset opts(sim,$m)
 390         }
 391     }
 392
 393     foreach i $opt_array {
 394         set opt_name [lindex $i 0]
 395         set opt_machs [lindex $i 1]
 396         set opt_val [lindex $i 2]
 397         if ![info exists opts($opt_name)] {
 398             perror "unknown option $opt_name in file $file"
 399             unresolved $subdir/$name
 400             return
 401         }
 402         # Multiple "output" specifications concatenate, they don't override.
 403         if { $opt_name == "output" } {
 404             set opt_val "$opts(output)$opt_val"
 405             set seen_output 1
 406         }
 407         # Similar with "xfail" and "kfail", but arguments are space-separated.
 408         if { $opt_name == "xfail" || $opt_name == "kfail" } {
 409             set opt_val "$opts($opt_name) $opt_val"
 410         }
 411
 412         # Similar for "requires", except we append a pair to a list, and
 413         # that doesn't match the processing in the rest of the loop, so we
 414         # "continue" early.
 415         if { $opt_name == "requires" } {
 416             lappend opts($opt_name) [split $opt_val " "]
 417             continue
 418         }
 419
 420         foreach m $opt_machs {
 421             set opts($opt_name,$m) $opt_val
 422         }
 423         if { "$opt_machs" == "" } {
 424             set opts($opt_name) $opt_val
 425         }
 426     }
 427
 428     if { $opts(progos) != "" && $opts(progos) != $global_cc_os } {
 429         untested $subdir/$name
 430         return
 431     }
 432
 433     set testname $name
 434     set sourcefile $file
 435     if { $seen_output == 0 } {
 436         if { "$opts(xerror)" == "no" } {
 437             set opts(output) "pass\n"
 438         } else {
 439             set opts(output) "fail\n"
 440         }
 441     }
 442     # Change \n sequences to newline chars.
 443     regsub -all "\\\\n" $opts(output) "\n" opts(output)
 444
 445     set testcase_machs $opts(mach)
 446     if { "$testcase_machs" == "all" } {
 447         set testcase_machs $requested_machs
 448     }
 449
 450     foreach mach $testcase_machs {
 451         if { [lsearch $requested_machs $mach] < 0 } {
 452             verbose -log "Skipping $mach version of $name, not requested."
 453             continue
 454         }
 455
 456         verbose -log "Testing $name on machine $mach."
 457
 458         # Time to setup xfailures and kfailures.
 459         if { "$opts(xfail)" != "" } {
 460             verbose -log "xfail: $opts(xfail)"
 461             # Using eval to make $opts(xfail) appear as individual
 462             # arguments.
 463             eval setup_xfail $opts(xfail)
 464         }
 465         if { "$opts(kfail)" != "" } {
 466             verbose -log "kfail: $opts(kfail)"
 467             eval setup_kfail $opts(kfail)
 468         }
 469
 470         if ![info exists opts(as,$mach)] {
 471             set opts(as,$mach) $opts(as)
 472         }
 473
 474         set as_options "$opts(as,$mach) -I$srcdir/$subdir"
 475         if [info exists cpu_option] {
 476             if ![info exists cpu_option_sep] {
 477                 set sep "="
 478             } {
 479                 set sep $cpu_option_sep
 480             }
 481             set as_options "$as_options $cpu_option$sep$mach"
 482         }
 483         regsub {(^ *| +)([^ ]+)} "$as_options" { -Wa,\2} c_as_options
 484
 485         if ![info exists opts(ld,$mach)] {
 486             set opts(ld,$mach) $opts(ld)
 487         }
 488         regsub {(^ *| +)([^ ]+)} "$opts(ld,$mach)" { -Wl,\2} c_ld_options
 489
 490         if ![info exists opts(cc,$mach)] {
 491             set opts(cc,$mach) $opts(cc)
 492         }
 493
 494         foreach req $opts(requires) {
 495             set what [lindex $req 0]
 496             set what_opt [lindex $req 1]
 497             verbose -log "requires: <$what> <$what_opt>"
 498             if { [info procs sim_check_requires_${what}] != [list] } {
 499                 if ![sim_check_requires_${what} $what_opt] {
 500                     untested $subdir/$name
 501                     return
 502                 }
 503             } {
 504                 perror "unknown requirement `requires: $what' in file $file"
 505                 unresolved $subdir/$name
 506                 return
 507             }
 508         }
 509
 510         if [string match "*.c" $sourcefile] {
 511             # If we don't have a compiler available, skip tests :(.
 512             if { $global_cc_works == 0 } {
 513                 untested $subdir/$name
 514                 return
 515             }
 516
 517             set comp_output [target_compile $sourcefile $objdir/${name}.x "executable" \
 518                 [list "incdir=$srcdir/$subdir" "additional_flags=$c_as_options $c_ld_options $opts(cc,$mach)"]]
 519             set method "compiling/linking"
 520         } else {
 521             # If we don't have an assembler available, skip tests :(.
 522             if { $global_as_works == 0 } {
 523                 untested $subdir/$name
 524                 return
 525             }
 526
 527             if [string match "*.S" $sourcefile] {
 528                 # If we don't have a preprocessor available, skip tests :(.
 529                 if { $global_cpp_works == 0 } {
 530                     untested $subdir/$name
 531                     return
 532                 }
 533
 534                 set comp_output [target_compile $sourcefile $objdir/${name}.o "object" \
 535                     [list "incdir=$srcdir/$subdir" "additional_flags=$c_as_options"]]
 536                 set method "compiling"
 537             } else {
 538                 set comp_output [target_assemble $sourcefile $objdir/${name}.o "$as_options"]
 539                 set method "assembling"
 540             }
 541
 542             if ![string match "" $comp_output] {
 543                 verbose -log "$comp_output" 3
 544                 fail "$mach $testname (${method})"
 545                 continue
 546             }
 547
 548             set comp_output [target_link $objdir/${name}.o $objdir/${name}.x "$opts(ld,$mach)"]
 549             set method "linking"
 550         }
 551
 552         if ![string match "" $comp_output] {
 553             verbose -log "$comp_output" 3
 554             fail "$mach $testname (${method})"
 555             continue
 556         }
 557
 558         # If no machine specific options, default to the general version.
 559         if ![info exists opts(sim,$mach)] {
 560             set opts(sim,$mach) $opts(sim)
 561         }
 562
 563         # Build the options argument.
 564         set options ""
 565         if { "$opts(timeout)" != "" } {
 566             set options "$options timeout=$opts(timeout)"
 567         }
 568
 569         set result [sim_run $objdir/${name}.x "$opts(sim,$mach) $SIMFLAGS_FOR_TARGET" "$opts(progopts)" "" "$options"]
 570         set return_code [lindex $result 0]
 571         set output [lindex $result 1]
 572
 573         set status fail
 574         if { $return_code == 77 } {
 575             set status unsupported
 576         } elseif { $return_code == $opts(status) } {
 577             set status pass
 578         }
 579
 580         if { "$status" == "pass" } {
 581             if { "$opts(xerror)" == "no" } {
 582                 if [string match $opts(output) $output] {
 583                     pass "$mach $testname"
 584                     file delete $objdir/${name}.o $objdir/${name}.x
 585                 } else {
 586                     verbose -log "status:  $return_code" 3
 587                     verbose -log "output:  $output" 3
 588                     verbose -log "pattern: $opts(output)" 3
 589                     fail "$mach $testname (execution)"
 590                 }
 591             } else {
 592                 verbose -log "`pass' return code when expecting failure" 3
 593                 fail "$mach $testname (execution)"
 594             }
 595         } elseif { "$status" == "fail" } {
 596             if { "$opts(xerror)" == "no" } {
 597                 fail "$mach $testname (execution)"
 598             } else {
 599                 if [string match $opts(output) $output] {
 600                     pass "$mach $testname"
 601                     file delete $objdir/${name}.o $objdir/${name}.x
 602                 } else {
 603                     verbose -log "status:  $return_code" 3
 604                     verbose -log "output:  $output" 3
 605                     verbose -log "pattern: $opts(output)" 3
 606                     fail "$mach $testname (execution)"
 607                 }
 608             }
 609         } else {
 610             $status "$mach $testname"
 611         }
 612     }
 613 }
 614
 615 # Subroutine of run_sim_test to process options in FILE.
 616
 617 proc slurp_options { file } {
 618     global subdir srcdir
 619     if [catch { set f [open $file r] } x] {
 620         #perror "couldn't open `$file': $x"
 621         perror "$x"
 622         return -1
 623     }
 624     set opt_array {}
 625     # whitespace expression
 626     set ws  {[  ]*}
 627     set nws {[^         ]*}
 628     # whitespace is ignored anywhere except within the options list;
 629     # option names are alphabetic only
 630     set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
 631     # Allow arbitrary lines until the first option is seen.
 632     set seen_opt 0
 633     while { [gets $f line] != -1 } {
 634         set line [string trim $line]
 635         # Whitespace here is space-tab.
 636         if [regexp $pat $line xxx opt_name opt_machs opt_val] {
 637             # match!
 638             set opt_val [string map [list \
 639                 {$pwd} [pwd] \
 640                 {$srcdir} "$srcdir" \
 641                 {$subdir} "$subdir" \
 642             ] "$opt_val"]
 643             lappend opt_array [list $opt_name $opt_machs $opt_val]
 644             set seen_opt 1
 645         } else {
 646             if { $seen_opt } {
 647                 break
 648             }
 649         }
 650     }
 651     close $f
 652     return $opt_array
 653 }
 654
 655 proc prune_warnings_extra { text } {
 656
 657     regsub -all "(^|\n)(\[^\n\]*: warning:\[^\n\]*missing \\.note\\.GNU-stack section\[^\n\]*\n?)+" $text "\\1" text
 658     regsub -all "(^|\n)(\[^\n\]*: NOTE: This behaviour is deprecated\[^\n\]*\n?)+" $text "\\1" text
 659
 660     regsub -all "(^|\n)(\[^\n\]*: warning:\[^\n\]*has a LOAD segment with RWX permissions\[^\n\]*\n?)+" $text "\\1" text
 661
 662     return $text
 663 }
 664
 665 if { [info procs saved-prune_warnings] == [list] } {
 666     rename prune_warnings saved-prune_warnings
 667     proc prune_warnings { text } {
 668         set text [saved-prune_warnings $text]
 669         set text [prune_warnings_extra $text]
 670         return $text
 671     }
 672 }