gcc/testsuite/lib/gm2.exp

   1 # Copyright (C) 2003-2023 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 3 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 GCC; see the file COPYING3.  If not see
  15 # <http://www.gnu.org/licenses/>.
  16
  17 # This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
  18 # for GNU Modula-2.
  19
  20 # we want to use libgloss so we can get find_gcc.
  21 load_lib libgloss.exp
  22 load_lib prune.exp
  23 load_lib gcc-defs.exp
  24 load_lib target-libpath.exp
  25 load_lib timeout.exp
  26 load_lib timeout-dg.exp
  27
  28
  29 if {[info exists individual_timeout]} {
  30     set gm2_previous_timeout $individual_timeout
  31 } else {
  32     set gm2_previous_timeout 10
  33 }
  34
  35
  36 # set gm2_previous_timeout $individual_timeout
  37
  38 # We should be able to complete any test in 10 seconds.
  39 dg-timeout S 10
  40
  41
  42 # only push one level.
  43
  44 proc gm2_push_timeout { secs } {
  45     global individual_timeout
  46     set individual_timeout $secs
  47 }
  48
  49
  50 proc gm2_pop_timeout { } {
  51     global individual_timeout
  52     global gm2_previous_timeout
  53     set individual_timeout $gm2_previous_timeout
  54 }
  55
  56
  57 #
  58 # GCC_UNDER_TEST is the compiler under test.
  59 #
  60
  61 #
  62 # default_gcc_version -- extract and print the version number of the compiler
  63 #
  64
  65 proc default_gcc_version { } {
  66     global GCC_UNDER_TEST
  67
  68     gm2_init;
  69
  70     # ignore any arguments after the command
  71     set compiler [lindex $GCC_UNDER_TEST 0]
  72
  73     if ![is_remote host] {
  74         set compiler_name [which $compiler];
  75     } else {
  76         set compiler_name $compiler;
  77     }
  78
  79     # verify that the compiler exists
  80     if { $compiler_name != 0 } then {
  81         set tmp [remote_exec host "$compiler --version"]
  82         set status [lindex $tmp 0];
  83         set output [lindex $tmp 1];
  84         regexp "version.*$" $output version
  85         if { $status == 0 && [info exists version] } then {
  86             clone_output "$compiler_name $version\n"
  87         } else {
  88             clone_output "Couldn't determine version of $compiler_name: $output\n"
  89         }
  90     } else {
  91         # compiler does not exist (this should have already been detected)
  92         warning "$compiler does not exist"
  93     }
  94 }
  95
  96 #
  97 # gcc_version -- Call default_gcc_version, so we can override it if needed.
  98 #
  99
 100 proc gcc_version { } {
 101     default_gcc_version;
 102 }
 103
 104 #
 105 # gm2_init -- called at the start of each .exp script.
 106 #
 107 # There currently isn't much to do, but always using it allows us to
 108 # make some enhancements without having to go back and rewrite the scripts.
 109 #
 110
 111 set gm2_initialized 0;
 112 set gm2_compile_method "default";
 113 set gm2_link_path "";
 114 set gm2_link_libraries "m2pim m2iso";
 115 set gm2_link_objects "";
 116
 117 proc gm2_set_compile_method { arg } {
 118     global gm2_compile_method;
 119
 120     send_log "********************************************\n"
 121     send_log "**** setting gm2_compile_method to $arg ****\n"
 122     send_log "********************************************\n"
 123     set gm2_compile_method $arg;
 124 }
 125
 126
 127 proc gm2_init { args } {
 128     global tmpdir;
 129     global objdir;
 130     global rootme;
 131     global base_dir;
 132     global tool_root_dir;
 133     global gluefile wrap_flags;
 134     global gm2_initialized;
 135     global GCC_UNDER_TEST;
 136     global TOOL_EXECUTABLE;
 137     global gm2_link_libraries;
 138     global gm2_link_objects;
 139     global gm2_link_path;
 140     global HAVE_LIBSTDCXX_V3;
 141
 142     if { $gm2_initialized == 1 } { return; }
 143
 144     set gm2_link_objects "";
 145     set GCC_UNDER_TEST [lookfor_file $rootme gm2];
 146     append GCC_UNDER_TEST " " -B[file dirname $rootme]/gcc " " ${args};
 147     append GCC_UNDER_TEST " " -fno-diagnostics-show-caret
 148     append GCC_UNDER_TEST " " -fno-diagnostics-show-line-numbers
 149     append GCC_UNDER_TEST " " -fdiagnostics-color=never
 150     send_log "GCC_UNDER_TEST is ${GCC_UNDER_TEST}\n"
 151
 152     if ![info exists tmpdir] then {
 153         set tmpdir /tmp;
 154     }
 155     if {[target_info needs_status_wrapper] != "" && \
 156             [target_info needs_status_wrapper] != "0" && \
 157             ![info exists gluefile]} {
 158         set gluefile ${tmpdir}/gcc-testglue.o;
 159         set result [build_wrapper $gluefile];
 160         if { $result != "" } {
 161             set gluefile [lindex $result 0];
 162             set wrap_flags [lindex $result 1];
 163         } else {
 164             unset gluefile
 165         }
 166     }
 167
 168     set gm2_link_path "[gm2_link_flags [get_multilibs]]";
 169     verbose $gm2_link_path 1
 170
 171     # Set the default timeout value, larger tests can override
 172     # this if necessary.
 173     dg-timeout S 10
 174 }
 175
 176
 177 #
 178 # gm2_target_compile_default -- compile a source file
 179 #
 180
 181 proc gm2_target_compile_default { source dest type options } {
 182     global gluefile wrap_flags
 183     global GCC_UNDER_TEST
 184     global TOOL_OPTIONS
 185     global TEST_ALWAYS_FLAGS
 186     global gm2_link_objects
 187     global gm2_link_libraries
 188     global gm2_link_path
 189
 190     if {[target_info needs_status_wrapper] != "" && \
 191             [target_info needs_status_wrapper] != "0" && \
 192             [info exists gluefile] } {
 193         lappend options "libs=${gluefile}"
 194         lappend options "ldflags=$wrap_flags"
 195     }
 196
 197     # TEST_ALWAYS_FLAGS are flags that should be passed to every
 198     # compilation.  They are passed first to allow individual
 199     # tests to override them.
 200     if [info exists TEST_ALWAYS_FLAGS] {
 201         set options [concat "{additional_flags=$TEST_ALWAYS_FLAGS}" $options]
 202     }
 203
 204     global TEST_EXTRA_LIBS
 205     if [info exists TEST_EXTRA_LIBS] {
 206         lappend options "ldflags=$TEST_EXTRA_LIBS"
 207     }
 208
 209     if [target_info exists gcc,stack_size] {
 210         lappend options "additional_flags=-DSTACK_SIZE=[target_info gcc,stack_size]"
 211     }
 212     if [target_info exists gcc,no_trampolines] {
 213         lappend options "additional_flags=-DNO_TRAMPOLINES"
 214     }
 215     if [target_info exists gcc,no_label_values] {
 216         lappend options "additional_flags=-DNO_LABEL_VALUES"
 217     }
 218     if [info exists TOOL_OPTIONS] {
 219         lappend options "additional_flags=$TOOL_OPTIONS"
 220     }
 221     lappend options "timeout=[timeout_value]"
 222     lappend options "compiler=$GCC_UNDER_TEST"
 223     # puts stderr "options = $options\n"
 224     # puts stderr "***** target_compile: $source $dest $type $options\n"
 225     return [target_compile $source $dest $type $options]
 226 }
 227
 228
 229 #
 230 # gm2_target_compile -- compile a source file
 231 #
 232
 233 proc gm2_target_compile { source dest type options } {
 234     global gm2_compile_method;
 235
 236     return [gm2_target_compile_${gm2_compile_method} $source $dest $type $options]
 237 }
 238
 239 #
 240 #  gm2_link_lib - allows tests to specify link libraries.
 241 #                  This _must_ be called before gm2_init.
 242 #
 243
 244 proc gm2_link_lib { libraries } {
 245     global gm2_link_libraries;
 246
 247     set gm2_link_libraries $libraries;
 248 }
 249
 250
 251 #
 252 #  gm2_link_obj - allows tests to specify link with objects.
 253 #
 254
 255 proc gm2_link_obj { objects } {
 256     global gm2_link_objects;
 257
 258     set gm2_link_objects $objects;
 259 }
 260
 261
 262 #
 263 #  gm2_link_flags - detects the whereabouts of libraries (-lstdc++).
 264 #
 265
 266 proc gm2_link_flags { paths } {
 267     global srcdir;
 268     global ld_library_path;
 269     global gccpath;
 270     global gm2_link_libraries;
 271
 272     set gccpath ${paths}
 273     set libio_dir ""
 274     set flags ""
 275     set ld_library_path "."
 276
 277     set shlib_ext [get_shlib_extension]
 278     verbose "shared lib extension: $shlib_ext"
 279
 280     if { $gccpath == "" } {
 281       global tool_root_dir
 282
 283       set libstdcpp [lookfor_file ${tool_root_dir} libstdc++]
 284       if { $libstdcpp != "" } {
 285           append flags "-L${libstdcpp} "
 286           append ld_library_path ":${libstdcpp}"
 287       }
 288     } else {
 289         if [file exists "${gccpath}/lib/libstdc++.a"] {
 290             append ld_library_path ":${gccpath}/lib"
 291         }
 292         if [file exists "${gccpath}/libstdc++/libstdc++.a"] {
 293             append flags "-L${gccpath}/libstdc++ "
 294             append ld_library_path ":${gccpath}/libstdc++"
 295         }
 296         if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.a"] {
 297             append flags " -L${gccpath}/libstdc++-v3/src/.libs "
 298             append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs"
 299         }
 300         # Look for libstdc++.${shlib_ext}.
 301         if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.${shlib_ext}"] {
 302             append flags " -L${gccpath}/libstdc++-v3/src/.libs "
 303             append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs"
 304         }
 305
 306         # puts stderr "${gm2_link_libraries}  before foreach"
 307         foreach d [list {*}${gm2_link_libraries}] {
 308             # puts stderr "${d}  XXXX"
 309             send_log "ld_library_path was ${ld_library_path}\n"
 310             send_log "looking for ${gccpath}/lib${d}/.libs/lib${d}.a\n"
 311             if [file exists "${gccpath}/libgm2/lib${d}/.libs/lib${d}.a"] {
 312                 send_log "good found ${gccpath}/libgm2/lib${d}/.libs/lib${d}.a\n"
 313                 # append flags " -L${gccpath}/libgm2/lib${d}/.libs -l${d}"
 314                 append flags " ${gccpath}/libgm2/lib${d}/.libs/lib${d}.a"
 315                 append ld_library_path ":${gccpath}/libgm2/lib${d}/.libs"
 316             }
 317             send_log "ld_library_path is ${ld_library_path}\n"
 318         }
 319     }
 320
 321     set_ld_library_path_env_vars
 322     return "$flags"
 323 }
 324
 325
 326 #
 327 #  gm2_init_pimx - set the default libraries to choose PIM and then ISO.
 328 #                  choose Modula-2, dialect.
 329 #
 330 #
 331
 332 proc gm2_init_pimx { dialect {path ""} args } {
 333     global srcdir;
 334     global gccpath;
 335
 336     set gm2src ${srcdir}/../m2;
 337
 338     send_log "srcdir is $srcdir\n"
 339     send_log "gccpath is $gccpath\n"
 340     send_log "gm2src is $gm2src\n"
 341
 342     set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
 343     set pimLpath "${gccpath}/libgm2/libm2pim/.libs";
 344
 345     set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso";
 346     set isoLpath "${gccpath}/libgm2/libm2iso/.libs";
 347
 348     set theIpath "-I${pimIpath} -I${isoIpath}";
 349     set theLpath "-L${pimLpath} -L${isoLpath}";
 350
 351     if { $path != "" } then {
 352         append theIpath " -I"
 353         append theIpath ${path}
 354     }
 355     gm2_init {*}${theIpath} {*}${dialect} {*}${theLpath} {*}${args};
 356 }
 357
 358 #
 359 #  gm2_init_pim - set the default libraries to choose PIM and then ISO.
 360 #
 361 #
 362
 363 proc gm2_init_pim { {path ""} args } {
 364     gm2_init_pimx -fpim {*}${path} {*}${args};
 365 }
 366
 367
 368 #
 369 #  gm2_init_pim2 - set the default libraries to choose PIM and then ISO.
 370 #                  It uses the PIM2 dialect.
 371 #
 372
 373 proc gm2_init_pim2 { {path ""} args } {
 374     gm2_init_pimx -fpim2 {*}${path} {*}${args};
 375 }
 376
 377
 378 #
 379 #  gm2_init_pim3 - set the default libraries to choose PIM and then ISO.
 380 #                  It uses the PIM3 dialect.
 381 #
 382
 383 proc gm2_init_pim3 { {path ""} args } {
 384     gm2_init_pimx -fpim3 {*}${path} {*}${args};
 385 }
 386
 387
 388 #
 389 #  gm2_init_pim4 - set the default libraries to choose PIM and then ISO.
 390 #                  It uses the PIM4 dialect.
 391 #
 392
 393 proc gm2_init_pim4 { {path ""} args } {
 394     gm2_init_pimx -fpim4 {*}${path} {*}${args};
 395 }
 396
 397
 398 #
 399 #  gm2_init_iso - set the default libraries to choose ISO and then PIM.
 400 #
 401
 402 proc gm2_init_iso { {path ""} args } {
 403     global srcdir;
 404     global gccpath;
 405
 406     set gm2src ${srcdir}/../m2;
 407
 408     set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso";
 409     set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
 410
 411     set isoLpath "${gccpath}/libgm2/libm2iso/.libs";
 412     set pimLpath "${gccpath}/libgm2/libm2pim/.libs";
 413
 414     set corIpath "${gccpath}/libgm2/libm2cor:${gm2src}/gm2-libs-coroutines";
 415     set corLpath "${gccpath}/libgm2/libm2cor/.libs";
 416
 417     set theIpath "-I${isoIpath} -I${corIpath} -I${pimIpath}";
 418     set theLpath "-L${isoLpath} -L${corLpath} -L${pimLpath}";
 419
 420     if { $path != "" } then {
 421         append theIpath " -I"
 422         append theIpath ${path}
 423     }
 424
 425     gm2_init {*}${theIpath} -fiso {*}${theLpath} {*}${args};
 426 }
 427
 428
 429 #
 430 #  gm2_init_ulm - set the default libraries to choose the ULM and PIM libraries.
 431 #
 432
 433 proc gm2_init_ulm { {path ""} args } {
 434     global srcdir;
 435     global gccpath;
 436
 437     set gm2src ${srcdir}/../m2;
 438
 439     set ulmIpath "${gccpath}/libgm2/libm2ulm:${gm2src}/ulm-lib-gm2/std:${gm2src}/ulm-lib-gm2/sys";
 440     set ulmLpath "${gccpath}/libgm2/libm2ulm/.libs";
 441
 442     set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
 443     set pimLpath "${gccpath}/libgm2/libm2pim/.libs";
 444
 445     set theIpath "-I${ulmIpath} -I${pimIpath}";
 446     set theLpath "-L${ulmLpath} -L${pimLpath}";
 447
 448     if { $path != "" } then {
 449         append theIpath " -I"
 450         append theIpath ${path}
 451     }
 452
 453     gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args};
 454 }
 455
 456
 457 #
 458 #  gm2_init_log - set the default libraries to choose LOG and then PIM.
 459 #
 460 #
 461
 462 proc gm2_init_log { {path ""} args } {
 463     global srcdir;
 464     global gccpath;
 465
 466     set gm2src ${srcdir}/../m2;
 467
 468     send_log "srcdir is $srcdir\n"
 469     send_log "gccpath is $gccpath\n"
 470     send_log "gm2src is $gm2src\n"
 471
 472     set logIpath "${gccpath}/libgm2/libm2log:${gm2src}/gm2-libs-pim";
 473     set logLpath "${gccpath}/libgm2/libm2log/.libs";
 474
 475     set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
 476     set pimLpath "${gccpath}/libgm2/libm2pim/.libs";
 477
 478     set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso";
 479     set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
 480
 481     set theIpath "-I${logIpath} -I${pimIpath} -I${isoIpath}";
 482     set theLpath "-L${logLpath} -L${pimLpath}";
 483
 484     if { $path != "" } then {
 485         append theIpath " -I"
 486         append theIpath ${path}
 487     }
 488
 489     gm2_link_lib "m2log m2pim m2iso"
 490     gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args};
 491 }
 492
 493 #
 494 #  gm2_init_cor - set the default libraries to choose COR and then PIM.
 495 #
 496 #
 497
 498 proc gm2_init_cor { {path ""} args } {
 499     global srcdir;
 500     global gccpath;
 501     global gm2_link_libraries;
 502
 503     set gm2src ${srcdir}/../m2;
 504
 505     send_log "srcdir is $srcdir\n"
 506     send_log "gccpath is $gccpath\n"
 507     send_log "gm2src is $gm2src\n"
 508
 509     set corIpath "${gccpath}/libgm2/libm2cor:${gm2src}/gm2-libs-coroutines";
 510     set corLpath "${gccpath}/libgm2/libm2cor/.libs";
 511
 512     set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs";
 513     set pimLpath "${gccpath}/libgm2/libm2pim/.libs";
 514
 515     set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso";
 516     set isoLpath "${gccpath}/libgm2/libm2iso/.libs";
 517
 518     set logIpath "${gccpath}/libgm2/libm2log:${gm2src}/gm2-libs-pim";
 519     set logLpath "${gccpath}/libgm2/libm2log/.libs";
 520
 521     set theIpath "-I${corIpath} -I${pimIpath} -I${logIpath} -I${isoIpath}";
 522     set theLpath "-L${corLpath} -L${pimLpath} -L${logLpath} -L${isoLpath}";
 523
 524     if { $path != "" } then {
 525         append theIpath " -I"
 526         append theIpath ${path}
 527     }
 528
 529     gm2_link_lib "m2cor m2pim m2iso"
 530     gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args};
 531 }
 532
 533
 534 #
 535 #  gm2_init_minx - set the default libraries to choose MIN library and
 536 #                  choose Modula-2, dialect.
 537 #
 538 #
 539
 540 proc gm2_init_minx { dialect {path ""} args } {
 541     global srcdir;
 542     global gccpath;
 543
 544     set gm2src ${srcdir}/../m2;
 545
 546     send_log "srcdir is $srcdir\n"
 547     send_log "gccpath is $gccpath\n"
 548     send_log "gm2src is $gm2src\n"
 549
 550     set minIpath "${gccpath}/libgm2/libm2min";
 551     set minLpath "${gccpath}/libgm2/libm2min/.libs";
 552
 553     set theIpath "-I${minIpath}";
 554     set theLpath "-L${minLpath}";
 555
 556     if { $path != "" } then {
 557         append theIpath " -I"
 558         append theIpath ${path}
 559     }
 560     gm2_init {*}${theIpath} {*}${dialect} {*}${theLpath} {*}${args};
 561 }
 562
 563 #
 564 #  gm2_init_min - set the default libraries to choose MIN libraries
 565 #                 and pim dialect.
 566 #
 567
 568 proc gm2_init_min { {path ""} args } {
 569     append args " -fno-exceptions"
 570     gm2_init_minx -fpim {*}${path} {*}${args};
 571 }