Here are the dejagnu expect library scripts for the gm2 testsuite.
------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/gcc/testsuite/lib/gm2.exp --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/testsuite/lib/gm2.exp 2022-10-07 20:21:18.718097775 +0100 @@ -0,0 +1,498 @@ +# Copyright (C) 2003-2020 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# <http://www.gnu.org/licenses/>. + +# This file was written by Gaius Mulley (gaius.mul...@southwales.ac.uk) +# for GNU Modula-2. + +# we want to use libgloss so we can get find_gcc. +load_lib libgloss.exp +load_lib prune.exp +load_lib gcc-defs.exp +load_lib target-libpath.exp + + +# +# GCC_UNDER_TEST is the compiler under test. +# + +# +# default_gcc_version -- extract and print the version number of the compiler +# + +proc default_gcc_version { } { + global GCC_UNDER_TEST + + gm2_init; + + # ignore any arguments after the command + set compiler [lindex $GCC_UNDER_TEST 0] + + if ![is_remote host] { + set compiler_name [which $compiler]; + } else { + set compiler_name $compiler; + } + + # verify that the compiler exists + if { $compiler_name != 0 } then { + set tmp [remote_exec host "$compiler --version"] + set status [lindex $tmp 0]; + set output [lindex $tmp 1]; + regexp "version.*$" $output version + if { $status == 0 && [info exists version] } then { + clone_output "$compiler_name $version\n" + } else { + clone_output "Couldn't determine version of $compiler_name: $output\n" + } + } else { + # compiler does not exist (this should have already been detected) + warning "$compiler does not exist" + } +} + +# +# gcc_version -- Call default_gcc_version, so we can override it if needed. +# + +proc gcc_version { } { + default_gcc_version; +} + +# +# gm2_init -- called at the start of each .exp script. +# +# There currently isn't much to do, but always using it allows us to +# make some enhancements without having to go back and rewrite the scripts. +# + +set gm2_initialized 0; +set gm2_compile_method "default"; +set gm2_link_path ""; +set gm2_link_libraries "m2pim m2iso"; +set gm2_link_objects ""; + +proc gm2_set_compile_method { arg } { + global gm2_compile_method; + + send_log "********************************************\n" + send_log "**** setting gm2_compile_method to $arg ****\n" + send_log "********************************************\n" + set gm2_compile_method $arg; +} + + +proc gm2_init { args } { + global tmpdir; + global objdir; + global rootme; + global base_dir; + global tool_root_dir; + global gluefile wrap_flags; + global gm2_initialized; + global GCC_UNDER_TEST; + global TOOL_EXECUTABLE; + global gm2_link_libraries; + global gm2_link_objects; + global gm2_link_path; + global HAVE_LIBSTDCXX_V3; + + if { $gm2_initialized == 1 } { return; } + + set gm2_link_objects ""; + set GCC_UNDER_TEST [lookfor_file $rootme gm2]; + append GCC_UNDER_TEST " " -B[file dirname $rootme]/gcc " " ${args}; + append GCC_UNDER_TEST " " -fno-diagnostics-show-caret + append GCC_UNDER_TEST " " -fno-diagnostics-show-line-numbers + append GCC_UNDER_TEST " " -fdiagnostics-color=never + send_log "GCC_UNDER_TEST is ${GCC_UNDER_TEST}\n" + + if ![info exists tmpdir] then { + set tmpdir /tmp; + } + if {[target_info needs_status_wrapper] != "" && \ + [target_info needs_status_wrapper] != "0" && \ + ![info exists gluefile]} { + set gluefile ${tmpdir}/gcc-testglue.o; + set result [build_wrapper $gluefile]; + if { $result != "" } { + set gluefile [lindex $result 0]; + set wrap_flags [lindex $result 1]; + } else { + unset gluefile + } + } + + set gm2_link_path "[gm2_link_flags [get_multilibs]]"; + verbose $gm2_link_path 1 +} + +# +# gm2_target_compile_default -- compile a source file +# + +proc gm2_target_compile_default { source dest type options } { + global gluefile wrap_flags + global GCC_UNDER_TEST + global TOOL_OPTIONS + global TEST_ALWAYS_FLAGS + global gm2_link_objects + global gm2_link_libraries + global gm2_link_path + + if {[target_info needs_status_wrapper] != "" && \ + [target_info needs_status_wrapper] != "0" && \ + [info exists gluefile] } { + lappend options "libs=${gluefile}" + lappend options "ldflags=$wrap_flags" + } + + # TEST_ALWAYS_FLAGS are flags that should be passed to every + # compilation. They are passed first to allow individual + # tests to override them. + if [info exists TEST_ALWAYS_FLAGS] { + set options [concat "{additional_flags=$TEST_ALWAYS_FLAGS}" $options] + } + + global TEST_EXTRA_LIBS + if [info exists TEST_EXTRA_LIBS] { + lappend options "ldflags=$TEST_EXTRA_LIBS" + } + + if [target_info exists gcc,stack_size] { + lappend options "additional_flags=-DSTACK_SIZE=[target_info gcc,stack_size]" + } + if [target_info exists gcc,no_trampolines] { + lappend options "additional_flags=-DNO_TRAMPOLINES" + } + if [target_info exists gcc,no_label_values] { + lappend options "additional_flags=-DNO_LABEL_VALUES" + } + if [info exists TOOL_OPTIONS] { + lappend options "additional_flags=$TOOL_OPTIONS" + } + if [target_info exists gcc,timeout] { + lappend options "timeout=[target_info gcc,timeout]" + } + lappend options "compiler=$GCC_UNDER_TEST" + # puts stderr "options = $options\n" + # puts stderr "***** target_compile: $source $dest $type $options\n" + return [target_compile $source $dest $type $options] +} + + +# +# gm2_target_compile -- compile a source file +# + +proc gm2_target_compile { source dest type options } { + global gm2_compile_method; + + return [gm2_target_compile_${gm2_compile_method} $source $dest $type $options] +} + +# +# gm2_link_lib - allows tests to specify link libraries. +# This _must_ be called before gm2_init. +# + +proc gm2_link_lib { libraries } { + global gm2_link_libraries; + + set gm2_link_libraries $libraries; +} + + +# +# gm2_link_obj - allows tests to specify link with objects. +# + +proc gm2_link_obj { objects } { + global gm2_link_objects; + + set gm2_link_objects $objects; +} + + +# +# gm2_link_flags - detects the whereabouts of libraries (-lstdc++). +# + +proc gm2_link_flags { paths } { + global srcdir; + global ld_library_path; + global gccpath; + global gm2_link_libraries; + + set gccpath ${paths} + set libio_dir "" + set flags "" + set ld_library_path "." + + set shlib_ext [get_shlib_extension] + verbose "shared lib extension: $shlib_ext" + + if { $gccpath == "" } { + global tool_root_dir + + set libstdcpp [lookfor_file ${tool_root_dir} libstdc++] + if { $libstdcpp != "" } { + append flags "-L${libstdcpp} " + append ld_library_path ":${libstdcpp}" + } + } else { + if [file exists "${gccpath}/lib/libstdc++.a"] { + append ld_library_path ":${gccpath}/lib" + } + if [file exists "${gccpath}/libstdc++/libstdc++.a"] { + append flags "-L${gccpath}/libstdc++ " + append ld_library_path ":${gccpath}/libstdc++" + } + if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.a"] { + append flags " -L${gccpath}/libstdc++-v3/src/.libs " + append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs" + } + # Look for libstdc++.${shlib_ext}. + if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.${shlib_ext}"] { + append flags " -L${gccpath}/libstdc++-v3/src/.libs " + append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs" + } + + # puts stderr "${gm2_link_libraries} before foreach" + foreach d [list {*}${gm2_link_libraries}] { + # puts stderr "${d} XXXX" + send_log "ld_library_path was ${ld_library_path}\n" + send_log "looking for ${gccpath}/lib${d}/.libs/lib${d}.a\n" + if [file exists "${gccpath}/libgm2/lib${d}/.libs/lib${d}.a"] { + send_log "good found ${gccpath}/libgm2/lib${d}/.libs/lib${d}.a\n" + # append flags " -L${gccpath}/libgm2/lib${d}/.libs -l${d}" + append flags " ${gccpath}/libgm2/lib${d}/.libs/lib${d}.a" + append ld_library_path ":${gccpath}/libgm2/lib${d}/.libs" + } + send_log "ld_library_path is ${ld_library_path}\n" + } + } + + set_ld_library_path_env_vars + return "$flags" +} + + +# +# gm2_init_pimx - set the default libraries to choose PIM and then ISO. +# choose Modula-2, dialect. +# +# + +proc gm2_init_pimx { dialect {path ""} args } { + global srcdir; + global gccpath; + + set gm2src ${srcdir}/../m2; + + send_log "srcdir is $srcdir\n" + send_log "gccpath is $gccpath\n" + send_log "gm2src is $gm2src\n" + + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + set pimLpath "${gccpath}/libgm2/libm2pim/.libs"; + + set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso"; + set isoLpath "${gccpath}/libgm2/libm2iso/.libs"; + + set theIpath "-I${pimIpath} -I${isoIpath}"; + set theLpath "-L${pimLpath} -L${isoLpath}"; + + if { $path != "" } then { + append theIpath " -I" + append theIpath ${path} + } + gm2_init {*}${theIpath} {*}${dialect} {*}${theLpath} {*}${args}; +} + +# +# gm2_init_pim - set the default libraries to choose PIM and then ISO. +# +# + +proc gm2_init_pim { {path ""} args } { + gm2_init_pimx -fpim {*}${path} {*}${args}; +} + + +# +# gm2_init_pim2 - set the default libraries to choose PIM and then ISO. +# It uses the PIM2 dialect. +# + +proc gm2_init_pim2 { {path ""} args } { + gm2_init_pimx -fpim2 {*}${path} {*}${args}; +} + + +# +# gm2_init_pim3 - set the default libraries to choose PIM and then ISO. +# It uses the PIM3 dialect. +# + +proc gm2_init_pim3 { {path ""} args } { + gm2_init_pimx -fpim3 {*}${path} {*}${args}; +} + + +# +# gm2_init_pim4 - set the default libraries to choose PIM and then ISO. +# It uses the PIM4 dialect. +# + +proc gm2_init_pim4 { {path ""} args } { + gm2_init_pimx -fpim4 {*}${path} {*}${args}; +} + + +# +# gm2_init_iso - set the default libraries to choose ISO and then PIM. +# + +proc gm2_init_iso { {path ""} args } { + global srcdir; + global gccpath; + + set gm2src ${srcdir}/../m2; + + set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso"; + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + + set isoLpath "${gccpath}/libgm2/libm2iso/.libs"; + set pimLpath "${gccpath}/libgm2/libm2pim/.libs"; + + set corIpath "${gccpath}/libgm2/libm2cor:${gm2src}/gm2-libs-coroutines"; + set corLpath "${gccpath}/libgm2/libm2cor/.libs"; + + set theIpath "-I${isoIpath} -I${corIpath} -I${pimIpath}"; + set theLpath "-L${isoLpath} -L${corLpath} -L${pimLpath}"; + + if { $path != "" } then { + append theIpath " -I" + append theIpath ${path} + } + + gm2_init {*}${theIpath} -fiso {*}${theLpath} {*}${args}; +} + + +# +# gm2_init_ulm - set the default libraries to choose the ULM and PIM libraries. +# + +proc gm2_init_ulm { {path ""} args } { + global srcdir; + global gccpath; + + set gm2src ${srcdir}/../m2; + + set ulmIpath "${gccpath}/libgm2/libm2ulm:${gm2src}/ulm-lib-gm2/std:${gm2src}/ulm-lib-gm2/sys"; + set ulmLpath "${gccpath}/libgm2/libm2ulm/.libs"; + + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + set pimLpath "${gccpath}/libgm2/libm2pim/.libs"; + + set theIpath "-I${ulmIpath} -I${pimIpath}"; + set theLpath "-L${ulmLpath} -L${pimLpath}"; + + if { $path != "" } then { + append theIpath " -I" + append theIpath ${path} + } + + gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args}; +} + + +# +# gm2_init_log - set the default libraries to choose LOG and then PIM. +# +# + +proc gm2_init_log { {path ""} args } { + global srcdir; + global gccpath; + + set gm2src ${srcdir}/../m2; + + send_log "srcdir is $srcdir\n" + send_log "gccpath is $gccpath\n" + send_log "gm2src is $gm2src\n" + + set logIpath "${gccpath}/libgm2/libm2log:${gm2src}/gm2-libs-pim"; + set logLpath "${gccpath}/libgm2/libm2log/.libs"; + + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + set pimLpath "${gccpath}/libgm2/libm2pim/.libs"; + + set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso"; + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + + set theIpath "-I${logIpath} -I${pimIpath} -I${isoIpath}"; + set theLpath "-L${logLpath} -L${pimLpath}"; + + if { $path != "" } then { + append theIpath " -I" + append theIpath ${path} + } + + gm2_link_lib "m2log m2pim m2iso" + gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args}; +} + +# +# gm2_init_cor - set the default libraries to choose COR and then PIM. +# +# + +proc gm2_init_cor { {path ""} args } { + global srcdir; + global gccpath; + global gm2_link_libraries; + + set gm2src ${srcdir}/../m2; + + send_log "srcdir is $srcdir\n" + send_log "gccpath is $gccpath\n" + send_log "gm2src is $gm2src\n" + + set corIpath "${gccpath}/libgm2/libm2cor:${gm2src}/gm2-libs-coroutines"; + set corLpath "${gccpath}/libgm2/libm2cor/.libs"; + + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + set pimLpath "${gccpath}/libgm2/libm2pim/.libs"; + + set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso"; + set isoLpath "${gccpath}/libgm2/libm2iso/.libs"; + + set logIpath "${gccpath}/libgm2/libm2log:${gm2src}/gm2-libs-pim"; + set logLpath "${gccpath}/libgm2/libm2log/.libs"; + + set theIpath "-I${corIpath} -I${pimIpath} -I${logIpath} -I${isoIpath}"; + set theLpath "-L${corLpath} -L${pimLpath} -L${logLpath} -L${isoLpath}"; + + if { $path != "" } then { + append theIpath " -I" + append theIpath ${path} + } + + gm2_link_lib "m2cor m2pim m2iso" + gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args}; +} diff -ruw /dev/null gcc-git-devel-modula2/gcc/testsuite/lib/gm2-dg.exp --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/testsuite/lib/gm2-dg.exp 2022-10-07 20:21:18.718097775 +0100 @@ -0,0 +1,77 @@ +# Copyright (C) 2021 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# <http://www.gnu.org/licenses/>. + +load_lib gcc-dg.exp + +# Define gm2 callbacks for dg.exp. + +proc gm2-dg-test { prog do_what extra_tool_flags } { + verbose "begin:gm2-dg-test" 1 + upvar dg-do-what dg-do-what + + # For now demote link and run tests to compile-only. + switch $do_what { + link - + run { + set do_what compile + set dg-do-what compile + } + } + + set result \ + [gcc-dg-test-1 gm2_target_compile $prog $do_what $extra_tool_flags] + + set comp_output [lindex $result 0] + set output_file [lindex $result 1] + verbose "end:gm2-dg-test" 1 + return [list $comp_output $output_file] +} + +proc gm2-dg-prune { system text } { + return [gcc-dg-prune $system $text] +} + +# Utility routines. + +# Modified dg-runtest that can cycle through a list of optimization options +# as c-torture does. +proc gm2-dg-runtest { testcases flags default-extra-flags } { + global runtests + global TORTURE_OPTIONS + + foreach test $testcases { + # If we're only testing specific files and this isn't one of + # them, skip it. + if ![runtest_file_p $runtests $test] { + continue + } + + # look if this is dg-do-run test, in which case + # we cycle through the option list, otherwise we don't + if [expr [search_for $test "dg-do run"]] { + set option_list $TORTURE_OPTIONS + } else { + set option_list [list { -O } ] + } + + set nshort [file tail [file dirname $test]]/[file tail $test] + + foreach flags_t $option_list { + verbose "Testing $nshort, $flags $flags_t" 1 + dg-test $test "$flags $flags_t" ${default-extra-flags} + } + } +} diff -ruw /dev/null gcc-git-devel-modula2/gcc/testsuite/lib/gm2-simple.exp --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/testsuite/lib/gm2-simple.exp 2022-10-07 20:21:18.718097775 +0100 @@ -0,0 +1,137 @@ +# Copyright (C) 2003-2020 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# <http://www.gnu.org/licenses/>. + +# This file was written by Gaius Mulley (gaius.mul...@southwales.ac.uk) +# for GNU Modula-2 + +load_lib file-format.exp +load_lib gm2.exp + +# +# gm2-simple-compile -- runs the compiler +# +# SRC is the full pathname of the testcase. +# OPTION is the specific compiler flag we're testing (eg: -O2). +# +proc gm2-simple-compile { src option } { + global output + global srcdir tmpdir + global host_triplet + + set output "$tmpdir/[file tail [file rootname $src]].o" + + regsub "^$srcdir/?" $src "" testcase + # If we couldn't rip $srcdir out of `src' then just do the best we can. + # The point is to reduce the unnecessary noise in the logs. Don't strip + # out too much because different testcases with the same name can confuse + # `test-tool'. + if [string match "/*" $testcase] { + set testcase "[file tail [file dirname $src]]/[file tail $src]" + } + + verbose "Testing $testcase, $option" 1 + + # Run the compiler and analyze the results. + set options "" + lappend options "additional_flags=$option" + + set comp_output [gm2_target_compile "$src" "$output" object $options]; + gm2_check_compile $testcase $option $output $comp_output + remote_file build delete $output + verbose "$comp_output" 1 +} + + +# +# gm2-simple-execute -- utility to compile and execute a testcase +# +# SOURCES is a list of full pathnames to the test source files. +# The first filename in this list forms the "testcase". +# +# If the testcase has an associated .x file, we source that to run the +# test instead. We use .x so that we don't lengthen the existing filename +# to more than 14 chars. +# +proc gm2-simple-execute { sources args option } { + global tmpdir tool srcdir output compiler_conditional_xfail_data; + global gm2_link_libraries; + global gm2_link_path; + global gm2_link_objects; + + # Use the first source filename given as the filename under test. + set src [lindex $sources 0]; + + if { [llength $args] > 0 } { + set additional_flags [lindex $args 0]; + } else { + set additional_flags ""; + } + # Check for alternate driver. + if [file exists [file rootname $src].x] { + verbose "Using alternate driver [file rootname [file tail $src]].x" 2 + set done_p 0; + catch "set done_p \[source [file rootname $src].x\]" + if { $done_p } { + return + } + } + + set executable $tmpdir/[file tail [file rootname $src].x]; + set objectfile $tmpdir/[file tail [file rootname $src].o]; + + regsub "^$srcdir/?" $src "" testcase + # If we couldn't rip $srcdir out of `src' then just do the best we can. + # The point is to reduce the unnecessary noise in the logs. Don't strip + # out too much because different testcases with the same name can confuse + # `test-tool'. + if [string match "/*" $testcase] { + set testcase "[file tail [file dirname $src]]/[file tail $src]" + } + + set execname "${executable}"; + + remote_file build delete $execname; + verbose "Testing $testcase, $option" 1 + + # start by setting options with option + set options [concat "{additional_flags=$gm2_link_objects} " $option] + # now append path -fno-libs=- and objects + set options [concat "{additional_flags=$gm2_link_path} " $options] + set options [concat "{additional_flags=-fno-libs=-} " $options] + set options [concat "{additional_flags=$gm2_link_objects} " $options] + + set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}]; + + if ![gm2_check_compile "${testcase} compilation" ${option} ${execname} $comp_output] { + unresolved "${testcase} execution, ${option}" + remote_file build delete $objectfile + return 0 + } + + set result [gm2_load "$execname" "" ""] + + set status [lindex $result 0]; + set output [lindex $result 1]; + if { $status == "fail" } { + ${tool}_fail $testcase $option + send_log "executed $execname with result $status" + } + if { $status == "pass" } { + ${tool}_pass $testcase $option + remote_file build delete $execname; + } + return 1 +} diff -ruw /dev/null gcc-git-devel-modula2/gcc/testsuite/lib/gm2-torture.exp --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/testsuite/lib/gm2-torture.exp 2022-10-07 20:21:18.718097775 +0100 @@ -0,0 +1,538 @@ +# Copyright (C) 2003-2020 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# <http://www.gnu.org/licenses/>. + +# This file was written by Rob Savoye. (r...@cygnus.com) +# and modified by Gaius Mulley (gaius.mul...@southwales.ac.uk) +# for GNU Modula-2 + +load_lib file-format.exp +load_lib target-libpath.exp + +# The default option list can be overridden by +# TORTURE_OPTIONS="{ { list1 } ... { listN } }" + +if ![info exists TORTURE_OPTIONS] { + # It is theoretically beneficial to group all of the O2/O3 options together, + # as in many cases the compiler will generate identical executables for + # all of them--and the c-torture testsuite will skip testing identical + # executables multiple times. + # Also note that -finline-functions is explicitly included in one of the + # items below, even though -O3 is also specified, because some ports may + # choose to disable inlining functions by default, even when optimizing. + set TORTURE_OPTIONS [list \ + { -g } \ + { -O } \ + { -O -g } \ + { -Os } \ + { -O3 -fomit-frame-pointer } \ + { -O3 -fomit-frame-pointer -finline-functions } ] +} + + +# +# very costly options follow +# +# set TORTURE_OPTIONS [list \ +\# { -g } \ +\# { -O } \ +\# { -O -g } \ +\# { -Os } \ +\# { -Os -g } \ +\# { -O0 } \ +\# { -O0 -g } \ +\# { -O1 } \ +\# { -O1 -g } \ +\# { -O2 } \ +\# { -O2 -g } \ +\# { -O3 } \ +\# { -O3 -g } \ +\# { -O3 -fomit-frame-pointer } \ +\# { -O3 -fomit-frame-pointer -finline-functions } ] +# +# +# + + + +# +# gm2-torture-compile -- runs the gm2-torture test +# +# SRC is the full pathname of the testcase. +# OPTION is the specific compiler flag we're testing (eg: -O2). +# +proc gm2-torture-compile { src option } { + global output + global srcdir tmpdir + global host_triplet + + set output "$tmpdir/[file tail [file rootname $src]].o" + + regsub "^$srcdir/?" $src "" testcase + # If we couldn't rip $srcdir out of `src' then just do the best we can. + # The point is to reduce the unnecessary noise in the logs. Don't strip + # out too much because different testcases with the same name can confuse + # `test-tool'. + if [string match "/*" $testcase] { + set testcase "[file tail [file dirname $src]]/[file tail $src]" + } + + # puts stderr "gm2-torture-compiler src = $src, option = $option\n" + + # Run the compiler and analyze the results. + set options "" + lappend options "additional_flags=${option}" + + set comp_output [gm2_target_compile "$src" "$output" object $options]; + # puts stderr "*** gm2 torture compile: $comp_output ${options} " + gm2_check_compile $testcase "$option" $output $comp_output + remote_file build delete $output + verbose "$comp_output" 1 +} + + +# +# gm2_check_compile_fail -- Reports and returns pass/fail for a compilation +# + +proc gm2_check_compile_fail {testcase option objname gcc_output} { + global tool + set fatal_signal "*cc: Internal compiler error: program*got fatal signal" + + if [string match "$fatal_signal 6" $gcc_output] then { + ${tool}_fail $testcase "Got Signal 6, $option" + return 0 + } + + if [string match "$fatal_signal 11" $gcc_output] then { + ${tool}_fail $testcase "Got Signal 11, $option" + return 0 + } + +# # We shouldn't get these because of -w, but just in case. +# if [string match "*cc:*warning:*" $gcc_output] then { +# warning "$testcase: (with warnings) $option" +# send_log "$gcc_output\n" +# unresolved "$testcase, $option" +# return 0 +# } + + set gcc_output [prune_warnings $gcc_output] + + set unsupported_message [${tool}_check_unsupported_p $gcc_output] + if { $unsupported_message != "" } { + unsupported "$testcase: $unsupported_message" + return 0 + } + + # remove any leftover LF/CR to make sure any output is legit + regsub -all -- "\[\r\n\]*" $gcc_output "" gcc_output + + # check for any internal error + if { [string match "internal error" $gcc_output] || + [string match "internal compiler error" $gcc_output] } then { + ${tool}_fail $testcase $option + return 0 + } + + # If any message remains, we pass, as it will be the error message + if ![string match "" $gcc_output] then { + ${tool}_pass $testcase $option + return 1 + } + + # a clean compilation means this test has failed + ${tool}_fail $testcase $option + return 1 +} + +# +# gm2-torture-compile-fail -- runs the gm2-torture test +# +# SRC is the full pathname of the testcase. +# OPTION is the specific compiler flag we're testing (eg: -O2). +# +proc gm2-torture-compile-fail { src option } { + global output + global srcdir tmpdir + global host_triplet + + # puts stderr "gm2-torture-compile-fail: ${option}\n" + set output "$tmpdir/[file tail [file rootname $src]].o" + + regsub "^$srcdir/?" $src "" testcase + # If we couldn't rip $srcdir out of `src' then just do the best we can. + # The point is to reduce the unnecessary noise in the logs. Don't strip + # out too much because different testcases with the same name can confuse + # `test-tool'. + if [string match "/*" $testcase] { + set testcase "[file tail [file dirname $src]]/[file tail $src]" + } + + verbose "Testing expected failure $testcase, $option" 1 + + # Run the compiler and analyze the results. + set options "" + set additional_flags "" + lappend options "additional_flags=$option" # do not use -w for gm2 + if { $additional_flags != "" } { + lappend options "additional_flags=$additional_flags" + } + + set comp_output [gm2_target_compile "$src" "$output" object $options]; + gm2_check_compile_fail $testcase $option $output $comp_output + remote_file build delete $output + verbose "$comp_output" 1 +} + +# +# gm2-torture-execute -- utility to compile and execute a testcase +# +# SOURCES is a list of full pathnames to the test source files. +# The first filename in this list forms the "testcase". +# +# If the testcase has an associated .x file, we source that to run the +# test instead. We use .x so that we don't lengthen the existing filename +# to more than 14 chars. +# +proc gm2-torture-execute { sources args success } { + global tmpdir tool srcdir output compiler_conditional_xfail_data; + global TORTURE_OPTIONS; + global gm2_link_libraries; + global gm2_link_objects; + global gm2_link_path; + + # Use the first source filename given as the filename under test. + set src [lindex $sources 0]; + + if { [llength $args] > 0 } { + set additional_flags [lindex $args 0]; + } else { + set additional_flags ""; + } + # Check for alternate driver. + if [file exists [file rootname $src].x] { + verbose "Using alternate driver [file rootname [file tail $src]].x" 2 + set done_p 0; + catch "set done_p \[source [file rootname $src].x\]" + if { $done_p } { + return + } + } + + set executable $tmpdir/[file tail [file rootname $src].x]; + set objectfile $tmpdir/[file tail [file rootname $src].o]; + + regsub "^$srcdir/?" $src "" testcase + # If we couldn't rip $srcdir out of `src' then just do the best we can. + # The point is to reduce the unnecessary noise in the logs. Don't strip + # out too much because different testcases with the same name can confuse + # `test-tool'. + if [string match "/*" $testcase] { + set testcase "[file tail [file dirname $src]]/[file tail $src]" + } + + set option_list $TORTURE_OPTIONS; + + set count 0; + set oldstatus "foo"; + foreach option $option_list { + if { $count > 0 } { + set oldexec $execname; + } + set execname "${executable}${count}"; + incr count; + + # torture_{compile,execute}_xfail are set by the .x script + # (if present) + if [info exists torture_compile_xfail] { + setup_xfail $torture_compile_xfail + } + + # torture_execute_before_{compile,execute} can be set by the .x script + # (if present) + if [info exists torture_eval_before_compile] { + set ignore_me [eval $torture_eval_before_compile] + } + + remote_file build delete $execname; + verbose "Testing $testcase, $option" 1 + + set options "" + lappend options "additional_flags=$option" + if { $additional_flags != "" } { + lappend options "additional_flags=$additional_flags" + } + set comp_output [gm2_target_compile "$sources" "${objectfile}" object "$options"]; + + # puts stderr "torture gm2 case: $comp_output ${options} " + + if ![gm2_check_compile "$testcase compilation" ${options} $objectfile $comp_output] { + unresolved "$testcase execution, ${options}" + send_log "compile failed not attempting link\n" + remote_file build delete $objectfile + continue + } + + send_log "finished compile now attempting link\n" + # now link the test + set options ${option}; + + if { [llength ${args}] > 0 } { + lappend options "additional_flags=[lindex ${args} 0]" + } + + lappend options " additional_flags=${gm2_link_path}" + + if {$gm2_link_path != ""} { + lappend options " ldflags=$gm2_link_path" + } + + if {$gm2_link_libraries != ""} { + lappend options " ldflags=$gm2_link_libraries" + } + +# lappend options "ldflags=/home/gaius/GM2/graft-combine/build-devel-modula2-enabled/x86_64-pc-linux-gnu/libgm2/libm2pim/.libs/libm2pim.a" +# lappend options "ldflags=/home/gaius/GM2/graft-combine/build-devel-modula2-enabled/x86_64-pc-linux-gnu/libgm2/libm2iso/.libs/libm2iso.a" +# lappend options "ldflags=-lm2pim -lm2iso" +# + if {$gm2_link_objects != ""} { + lappend options " additional_flags=${gm2_link_objects}" + } + if {$gm2_link_path != ""} { + lappend options " additional_flags=${gm2_link_path}" + } + + # lappend options " additional_flags=${gm2_link_objects}" + # lappend options " additional_flags=${gm2_link_path}" + # lappend options " additional_flags=${gm2_link_libraries}" + set options [concat "{additional_flags=$gm2_link_path} " $options] + set options [concat "{additional_flags=-fno-libs=-} " $options] + set options [concat "{additional_flags=$gm2_link_objects} " $options] + # set options [concat "{additional_flags=$gm2_link_libraries} " $options] + + send_log "gm2_link_path = $gm2_link_path\n" + send_log "attempting link\n" + set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}]; + # puts "Link libraries are: ${gm2_link_libraries}" + # puts "Link path is : ${gm2_link_path}" + + if ![gm2_check_compile "${testcase} compilation" ${option} ${execname} ${comp_output}] { + send_log "unsuccessful link\n" + unresolved "${testcase} execution, ${option} (link failed)" + verbose "tried to link ${testcase} ${sources} ${execname} executable ${options}" 1 + verbose "Link libraries are: ${gm2_link_libraries}" 1 + verbose "Link path is : ${gm2_link_path}" 1 + verbose "$comp_output" 1 + lappend options "additional_flags=-fsources" + lappend options "additional_flags=-v" + verbose "****** s t a r t *********" 1 + set comp_output [gm2_target_compile "$sources" "${objectfile}" object ${options}]; + verbose "$comp_output" 1 + set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}]; + verbose "$comp_output" 1 + verbose "****** e n d *********" 1 + remote_file build delete $execname + remote_file build delete $objectfile + continue + } + + send_log "successful link\n" + # See if this source file uses "long long" types, if it does, and + # no_long_long is set, skip execution of the test. + if [target_info exists no_long_long] then { + if [expr [search_for $src "long long"]] then { + unsupported "$testcase execution, $option" + continue + } + } + + if [info exists torture_execute_xfail] { + setup_xfail $torture_execute_xfail + } + + if [info exists torture_eval_before_execute] { + set ignore_me [eval $torture_eval_before_execute] + } + + # Sometimes we end up creating identical executables for two + # consecutive sets of different of compiler options. + # + # In such cases we know the result of this test will be identical + # to the result of the last test. + # + # So in cases where the time to load and run/simulate the test + # is relatively high, compare the two binaries and avoid rerunning + # tests if the executables are identical. + # + # Do not do this for native testing since the cost to load/execute + # the test is fairly small and the comparison step actually slows + # the entire process down because it usually does not "hit". + set skip 0; + if { ![isnative] && [info exists oldexec] } { + if { [remote_file build cmp $oldexec $execname] == 0 } { + set skip 1; + } + } + if { $skip == 0 } { + set result [gm2_load "$execname" "" ""] + set status [lindex $result 0]; + set output [lindex $result 1]; + if { $success == "fail" } { + # invert the result + if { $status == "pass" } { + set status "fail" + } else { + set status "pass" + } + } + send_log "executed $execname with result $status" + } + if { $oldstatus == "pass" } { + remote_file build delete $oldexec; + } + $status "$testcase execution, $option" + set oldstatus $status; + } + if [info exists status] { + if { $status == "pass" } { + remote_file build delete $execname; + remote_file build delete $objectfile; + } + } +} + +# +# search_for -- looks for a string match in a file +# +proc search_for { file pattern } { + set fd [open $file r] + while { [gets $fd cur_line]>=0 } { + if [string match "*$pattern*" $cur_line] then { + close $fd + return 1 + } + } + close $fd + return 0 +} + +# +# gm2-torture -- the gm2-torture testcase source file processor +# +# This runs compilation only tests (no execute tests). +# SRC is the full pathname of the testcase, or just a file name in which case +# we prepend $srcdir/$subdir. +# +# If the testcase has an associated .x file, we source that to run the +# test instead. We use .x so that we don't lengthen the existing filename +# to more than 14 chars. +# +proc gm2-torture { args } { + global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS + + set src [lindex $args 0]; + if { [llength $args] > 1 } { + set options [lindex $args 1]; + } else { + set options "" + } + + # Prepend $srdir/$subdir if missing. + if ![string match "*/*" $src] { + set src "$srcdir/$subdir/$src" + } + + # Check for alternate driver. + if [file exists [file rootname $src].x] { + verbose "Using alternate driver [file rootname [file tail $src]].x" 2 + set done_p 0 + catch "set done_p \[source [file rootname $src].x\]" + if { $done_p } { + return + } + } + + set option_list $TORTURE_OPTIONS + + # loop through all the options + foreach option $option_list { + # torture_compile_xfail is set by the .x script (if present) + if [info exists torture_compile_xfail] { + setup_xfail $torture_compile_xfail + } + + # torture_execute_before_compile is set by the .x script (if present) + if [info exists torture_eval_before_compile] { + set ignore_me [eval $torture_eval_before_compile] + } + + gm2-torture-compile $src "$option $options" + } +} + +# +# gm2-torture -- the gm2-torture testcase source file processor +# +# This runs compilation only tests (no execute tests). +# SRC is the full pathname of the testcase, or just a file name in which case +# we prepend $srcdir/$subdir. +# +# If the testcase has an associated .x file, we source that to run the +# test instead. We use .x so that we don't lengthen the existing filename +# to more than 14 chars. +# +proc gm2-torture-fail { args } { + global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS + + set src [lindex $args 0]; + if { [llength $args] > 1 } { + set options [lindex $args 1]; + } else { + set options "" + } + + # Prepend $srdir/$subdir if missing. + if ![string match "*/*" $src] { + set src "$srcdir/$subdir/$src" + } + + # Check for alternate driver. + if [file exists [file rootname $src].x] { + verbose "Using alternate driver [file rootname [file tail $src]].x" 2 + set done_p 0 + catch "set done_p \[source [file rootname $src].x\]" + if { $done_p } { + return + } + } + + set option_list $TORTURE_OPTIONS + + # loop through all the options + foreach option $option_list { + # torture_compile_xfail is set by the .x script (if present) + if [info exists torture_compile_xfail] { + setup_xfail $torture_compile_xfail + } + + # torture_execute_before_compile is set by the .x script (if present) + if [info exists torture_eval_before_compile] { + set ignore_me [eval $torture_eval_before_compile] + } + + gm2-torture-compile-fail $src "$option $options" + } +}
