[v3,17/19] modula2 front end: dejagnu expect library scripts

Message ID E1p2ZEG-004Qhj-S4@lancelot
State New
Headers
Series [v3,1/19] modula2 front end: changes outside gcc/m2, libgm2 and gcc/testsuite. |

Commit Message

Gaius Mulley Dec. 6, 2022, 2:47 p.m. UTC
  Here are the dejagnu expect library scripts for the gm2
testsuite.

 
------8<----------8<----------8<----------8<----------8<----------8<----
  

Comments

Jason Merrill Jan. 10, 2023, 1:09 a.m. UTC | #1
On 12/6/22 09:47, Gaius Mulley via Gcc-patches wrote:
> Here are the dejagnu expect library scripts for the gm2
> testsuite.

A couple of weeks ago I noticed on a testrun that the modula tests 
didn't seem to be timing out properly, so I made this change.  It looks 
like they didn't run at all in the bootstrap/test I did just now, so I 
don't know if this change is actually helpful, but here it is if you 
think it makes sense:
  
Gaius Mulley Jan. 10, 2023, 10:48 p.m. UTC | #2
Jason Merrill <jason@redhat.com> writes:

> On 12/6/22 09:47, Gaius Mulley via Gcc-patches wrote:
>> Here are the dejagnu expect library scripts for the gm2
>> testsuite.
>
> A couple of weeks ago I noticed on a testrun that the modula tests
> didn't seem to be timing out properly, so I made this change.  It
> looks like they didn't run at all in the bootstrap/test I did just
> now, so I don't know if this change is actually helpful, but here it
> is if you think it makes sense:

awesome, many thanks for the patch - it certainly looks as if the
timeout library was absent from lib/gm2.exp (and also gm2-torture.exp).
I've also applied this fix to gm2-torture.exp and will git commit/git
push your patch

regards,
Gaius
  

Patch

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-12-06 02:56:51.424775814 +0000
@@ -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.mulley@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-12-06 02:56:51.424775814 +0000
@@ -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-12-06 02:56:51.424775814 +0000
@@ -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.mulley@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-12-06 02:56:51.424775814 +0000
@@ -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. (rob@cygnus.com)
+# and modified by Gaius Mulley (gaius.mulley@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"
+    }
+}