gcc/testsuite/g++.dg/modules/modules.exp

# Copyright (C) 2017-2026 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/>.
#
# Contributed by Nathan Sidwell <nathan@acm.org> while at Facebook


# Test C++ modules, which requires multiple TUs
#
# A test case might consist of multiple source files, each is compiled
# separately, in a well-defined order.  The resulting object files might
# be optionally linked and optionally executed.  Grouping is indicated by
# naming files '*_[a-z].[CH]'

# { dg-module-cmi "[!]module-name" } # an interface file is (not) expected
# { dg-module-do [link|run] [xfail] [options] } # link [and run]

load_lib g++-dg.exp
load_lib modules.exp

# If a testcase doesn't have special options, use these.
global DEFAULT_CXXFLAGS
if ![info exists DEFAULT_CXXFLAGS] then {
    set DEFAULT_CXXFLAGS " -pedantic-errors -Wno-long-long"
}
set DEFAULT_MODFLAGS $DEFAULT_CXXFLAGS

dg-init

if {[is_remote host]} {
    # remote testing not functional here :(
    return
}

if { [istarget "powerpc-ibm-aix*"] } {
    set torture_execute_xfail "powerpc-ibm-aix*"
    return
}

global module_do
global module_cmis

set DEFAULT_REPO "gcm.cache"

# Return the pathname for <HNAME>.
# On failure this will return garbage that results in the understandable
# FAIL: g++.dg/modules/compile-std1.C module-cmi <bits/stdcx++.h> (gcm.cache/,/ader_path1095619.C:1:10: fatal error: bits/stdcx++.h: No such file or directory.gcm)
# ??? it would be nice to have a simple --print-include-name flag.
proc host_header_path {hname} {
    global tool
    set src header_path[pid].C
    set f [open $src "w"]
    puts $f "#include <$hname>"
    close $f
    set opts [list "additional_flags=-H" "additional_flags=-fdirectives-only"]
    set lines [${tool}_target_compile $src /dev/null preprocess $opts]
    file delete $f
    # The first line of the -H output is ". /path/to/hname"
    set newline_idx [expr {[string first "\n" $lines] - 1}]
    set path [string range $lines 2 $newline_idx]
    verbose "header_path: $path" 1
    return $path
}

# Return the pathname CMI munged like the compiler.
proc munge_cmi {cmi} {
    if { [string index $cmi 0] == "/" } {
	set cmi [string range $cmi 1 end]
    } else {
	set cmi ",/$cmi"
    }
    set path [file split $cmi]
    # subst /../ -> /,,/
    # sadly tcl 8.5 does not have lmap
    set rplac {}
    foreach elt $path {lappend rplac [expr {$elt == ".." ? ",," : $elt}]}
    set cmi [file join {*}$rplac]
    verbose "munge_cmi: $cmi" 1
    return $cmi
}

# Register the module name this produces.
# dg-module-cmi !?=?NAME WHEN?
# dg-module-cmi !?{} - header unit
proc dg-module-cmi { args } {
    if { [llength $args] > 3 } {
	error "[lindex $args 0]: too many arguments"
	return
    }
    set spec [lindex $args 1]
    if { [llength $args] > 2 } {
	set when [lindex $args 2]
    } else {
	set when {}
    }

    if { [string index $spec 0] == "!" } {
	set name [string range $spec 1 end]
	set not 1
    } else {
	set name $spec
	set not 0
    }

    if { [string index $name 0] == "=" } {
	set cmi [string range $name 1 end]
    } else {
	if { $name == "" } {
	    # get the source file name.  ick!
	    upvar prog srcname
	    set cmi [munge_cmi "$srcname.gcm"]
	} elseif { [string index $name 0] == "<"
		   && [string index $name end] == ">" } {
	    set header "[regsub {<(.*)>} $name {\1}]"
	    set cmi [munge_cmi "[host_header_path $header].gcm"]
	} else {
	    set cmi "[regsub : $name -].gcm"
	}
	global DEFAULT_REPO
	set cmi "$DEFAULT_REPO/$cmi"
    }

    # delete file, so we don't get confused by a stale one.
    file_on_host delete "$cmi"

    global module_cmis
    lappend module_cmis [list $spec $when $not $cmi]
}

# check the expected module files exist (or not)
# return list to delete
proc module_cmi_p { src ifs } {
    set res {}
    foreach if_arg $ifs {
	set spec [lindex $if_arg 0]
	set when [lindex $if_arg 1]
	if { $when != "" } {
	    switch [dg-process-target $when] {
		"S" { }
		"N" { continue }
		"F" { setup_xfail "*-*-*" }
		"P" { }
	    }
	}
	set not [lindex $if_arg 2]
	set cmi [lindex $if_arg 3]
	global srcdir
	set relcmi [string map [list $srcdir "/\$srcdir"] $cmi]
	if { $not != [file_on_host exists $cmi] } {
	    pass "$src module-cmi $spec ($relcmi)"
	} else {
	    fail "$src module-cmi $spec ($relcmi)"
	    set not [expr ! $not ]
	}
	if { ! $not } {
	    lappend res $cmi
	}
    }
    return $res
}

# link and maybe run a set of object files
# dg-module-do WHAT WHEN
proc dg-module-do { args } {
    if { [llength $args] > 3 } {
	error "[lindex $args 0]: too many arguments"
	return
    }

    set do_what [lindex $args 1]
    set expected "P"
    if { [llength $args] > 2 } {
	set expected [dg-process-target [lindex $args 2]]
    }

    global module_do
    set module_do [list $do_what $expected]
}

proc module_do_it { do_what testcase std asm_list } {
    global tool

    set run 0
    switch [lindex $do_what 0] {
	"compile" { return 1 }
	"link" { }
	"run" { set run 1 }
	default { error "unknown module-do action [lindex $do_what 0]" }
    }

    set xfail {}
    switch [lindex $do_what 1] {
	"S" { }
	"N" { return 1 }
	"F" { set xfail {setup_xfail "*-*-*"} }
	"P" { }
    }

    set ok 1
    # make sure all asms are around
    foreach asm $asm_list {
	if { ! [file_on_host exists $asm] } {
	    set ok 0
	}
    }

    set options { }
    set ident $testcase
    if { $std != "" } {
	lappend options "additional_flags=$std"
	set ident "$ident $std"
    }
    global extra_tool_flags
    if { [llength $extra_tool_flags] } {
	lappend options "additional_flags=$extra_tool_flags"
    }

    set execname "./[file tail $testcase].exe"

    # link it
    verbose "Linking $asm_list" 1
    if { !$ok } {
	unresolved "$ident link"
    } else {
	global target_triplet
	set out [${tool}_target_compile $asm_list \
		     $execname executable $options]
	eval $xfail

	# Do gcc-specific pruning.
	set out [${tool}-dg-prune $target_triplet $out]
	# Fix up remaining line-breaks similar to "regular" pruning
	# calls.  Otherwise, a multi-line message stripped e.g. one
	# part by the default prune_warnings and one part part by the
	# gcc prune_gcc_output will have a residual line-break.
	regsub "^\[\r\n\]+" $out "" out

	if { $out == "" } {
	    pass "$ident link"
	} else {
	    fail "$ident link"
	    set ok 0
	}
    }

    # run it?
    if { !$run } {
    } elseif { !$ok } {
	unresolved "$ident execute"
    } else {
	set out [${tool}_load $execname "" ""]
	set status [lindex $out 0]
	eval $xfail
	$status "$ident execute"
	if { $status != "pass" } {
	    set $ok 0
	}
    }

    if { $ok } {
	file_on_host delete $execname
    }

    return $ok
}

# delete the specified set of module files
proc cleanup_module_files { files } {
    foreach file $files {
	file_on_host delete $file
    }
}

global testdir
set testdir $srcdir/$subdir
proc srcdir {} {
    global testdir
    return $testdir
}

# Return set of std options to iterate over.
proc module-init { src } {
    set option_list [g++-std-flags $src]
    global extra_tool_flags
    set extra_tool_flags {}

    if { [llength $option_list]
	 && ( [string match "*xtreme*" $src]
	      || [string match "*compile-std*" $src] ) } {
	# Only run the xtreme tests once.
	set option_list [lrange [lsort $option_list] end end]
    }

    return $option_list
}

# Return 1 if requirements are met
proc module-check-requirements { tests } {
    foreach test $tests {
	set tmp [dg-get-options $test]
	foreach op $tmp {
	    switch [lindex $op 0] {
		"dg-additional-options" {
		    # Example strings to match:
		    # -fmodules-ts -fmodule-mapper=|@g++-mapper-server\\ -t\\ [srcdir]/inc-xlate-1.map
		    # -fmodules-ts -fmodule-mapper=|@g++-mapper-server
		    if [regexp -- {(^| )-fmodule-mapper=\|@([^\\ ]*)} [lindex $op 2] dummy dummy2 prog] {
			verbose "Checking that mapper exist: $prog"
			if { ![ check_is_prog_name_available $prog ] } {
			    return 0
			}
		    }
		}
	    }
	}
    }
    return 1
}

# cleanup any detritus from previous run
cleanup_module_files [find $DEFAULT_REPO *.gcm]

# Override unsupported to set the second element of module_do to "N",
# so that, after an unsupported result in dg-test, we can skip rather
# than fail subsequent related tests.
set module_do {"compile" "P"}
rename unsupported modules-saved-unsupported
proc unsupported { args } {
    global module_do
    lset module_do 1 "N"
    return [uplevel 1 modules-saved-unsupported $args]
}

# not grouped tests, sadly tcl doesn't have negated glob
foreach test [prune [lsort [find $srcdir/$subdir {*.[CH]}]] \
		  "$srcdir/$subdir/*_?.\[CH\]"] {
    if [runtest_file_p $runtests $test] {
	set nshort [file tail [file dirname $test]]/[file tail $test]

	set std_list [module-init $test]
	foreach std $std_list {
	    global module_cmis
	    set module_cmis {}
	    verbose "Testing $nshort $std" 1
	    dg-test $test "$std" $DEFAULT_MODFLAGS
	    if { [lindex $module_do 1] == "N" } {
		continue
	    }
	    set testcase [string range $test [string length "$srcdir/"] end]
	    cleanup_module_files [module_cmi_p $testcase $module_cmis]
	}
    }
}

# grouped tests
foreach src [lsort [find $srcdir/$subdir {*_a.[CHX}]] {
    # use the FOO_a.C name as the parallelization key
    if [runtest_file_p $runtests $src] {
	set tests [lsort [find [file dirname $src] \
			      [regsub {_a.[CHX]$} [file tail $src] {_[a-z].[CHX]}]]]

	if { ![module-check-requirements $tests] } {
	    set testcase [regsub {_a.[CH]} $src {}]
	    set testcase \
		[string range $testcase [string length "$srcdir/"] end]
	    unsupported $testcase
	    continue
	}

	set std_list [module-init $src]
	foreach std $std_list {
	    set mod_files {}
	    global module_do
	    set module_do {"compile" "P"}
	    set asm_list {}
	    set any_hdrs 0
	    global DEFAULT_REPO
	    file_on_host delete $DEFAULT_REPO
	    foreach test $tests {
		if { [lindex $module_do 1] != "N" } {
		    global module_cmis
		    set module_cmis {}
		    set nshort [file tail [file dirname $test]]/[file tail $test]
		    verbose "Testing $nshort $std" 1
		    switch [file extension $test] {
			".C" {		
			    lappend asm_list [file rootname [file tail $test]].s
			}
			".X" {
			    set any_hdrs 1
			}
		    }
		    dg-test -keep-output $test "$std" $DEFAULT_MODFLAGS
		    if { [lindex $module_do 1] == "N" } {
			break
		    }
		    set testcase [string range $test [string length "$srcdir/"] end]
		    lappend mod_files [module_cmi_p $testcase $module_cmis]
		}
	    }
	    set testcase [regsub {_a.[CH]} $src {}]
	    set testcase \
		[string range $testcase [string length "$srcdir/"] end]
	    module_do_it $module_do $testcase $std $asm_list
	    foreach asm $asm_list {
		file_on_host delete $asm
	    }
	    if { $any_hdrs } {
		set mod_files [find $DEFAULT_REPO *.gcm]
	    }
	    cleanup_module_files $mod_files
	}
    }
}

# Restore the original unsupported proc, lest it will affect
# subsequent test runs, or even fail renaming if we run modules.exp
# for multiple targets/multilibs/options.
rename unsupported {}
rename modules-saved-unsupported unsupported

dg-finish