Simple cobol.dg testsuite
The following adds a simple cobol.dg test harness, based on gfortran.dg.
It's invoked by make check-cobol, has three tests, two execution test and
one test exercising dg-error. The existing FAIL is due to an assembling
error, tracked by PR119214.
Running /home/rguenther/src/gcc/gcc/testsuite/cobol.dg/dg.exp ...
FAIL: cobol.dg/pass.cob -O3 -fomit-frame-pointer -funroll-loops -fpeel-loops -ftracer -finline-functions (test for excess errors)
FAIL: cobol.dg/fail.cob -O3 -fomit-frame-pointer -funroll-loops -fpeel-loops -ftracer -finline-functions (test for excess errors)
=== cobol Summary ===
# of expected passes 12
# of unexpected failures 1
# of unresolved testcases 1
gcc/cobol/
* Make-lang.in (lang_checks): Add check-cobol.
gcc/testsuite/
* lib/cobol-dg.exp: New, based on gfortran-dg.exp.
* lib/cobol.exp: New, based on gfortran.exp.
* cobol.dg/dg.exp: New.
* cobol.dg/pass.cob: New test.
* cobol.dg/fail.cob: Likewise.
* cobol.dg/error-1.cob: Likewise.
This commit is contained in:
Richard Biener
Richard Biener
parent
da967f0ff3
commit
5712e33378
7 changed files with 440 additions and 0 deletions
|
|
@ -367,3 +367,5 @@ cobol.stagefeedback: stagefeedback-start
|
|||
-mv cobol/*$(objext) stagefeedback/cobol
|
||||
|
||||
selftest-cobol:
|
||||
|
||||
lang_checks += check-cobol
|
||||
|
|
|
|||
41
gcc/testsuite/cobol.dg/dg.exp
Normal file
41
gcc/testsuite/cobol.dg/dg.exp
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
# Copyright (C) 2004-2025 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/>.
|
||||
|
||||
# GCC testsuite that uses the `dg.exp' driver.
|
||||
|
||||
# Load support procs.
|
||||
load_lib cobol-dg.exp
|
||||
|
||||
# If a testcase doesn't have special options, use these.
|
||||
global DEFAULT_COBFLAGS
|
||||
if ![info exists DEFAULT_COBFLAGS] then {
|
||||
set DEFAULT_COBFLAGS " "
|
||||
}
|
||||
|
||||
# Initialize `dg'.
|
||||
dg-init
|
||||
|
||||
global cobol_test_path
|
||||
set cobol_test_path $srcdir/$subdir
|
||||
|
||||
set all_flags $DEFAULT_COBFLAGS
|
||||
|
||||
# Main loop.
|
||||
cobol-dg-runtest [lsort \
|
||||
[glob -nocomplain $srcdir/$subdir/*.cob ] ] "" $all_flags
|
||||
|
||||
# All done.
|
||||
dg-finish
|
||||
9
gcc/testsuite/cobol.dg/error-1.cob
Normal file
9
gcc/testsuite/cobol.dg/error-1.cob
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
*> { dg-do compile }
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. error-1.
|
||||
ENVIRONMENT DIVISION.
|
||||
DATA DIVISION.
|
||||
WORKING-STORAGE SECTION.
|
||||
02 VAR PIC S9(3) VALUE 1. *> { dg-error "not part of" }
|
||||
PROCEDURE DIVISION.
|
||||
STOP RUN.
|
||||
6
gcc/testsuite/cobol.dg/fail.cob
Normal file
6
gcc/testsuite/cobol.dg/fail.cob
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
*> { dg-do run { xfail *-*-* } }
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. fail.
|
||||
ENVIRONMENT DIVISION.
|
||||
PROCEDURE DIVISION.
|
||||
STOP RUN ERROR 1.
|
||||
6
gcc/testsuite/cobol.dg/pass.cob
Normal file
6
gcc/testsuite/cobol.dg/pass.cob
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
*> { dg-do run }
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. pass.
|
||||
ENVIRONMENT DIVISION.
|
||||
PROCEDURE DIVISION.
|
||||
STOP RUN.
|
||||
85
gcc/testsuite/lib/cobol-dg.exp
Normal file
85
gcc/testsuite/lib/cobol-dg.exp
Normal file
|
|
@ -0,0 +1,85 @@
|
|||
# Copyright (C) 2004-2025 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
|
||||
load_lib torture-options.exp
|
||||
|
||||
# Define cobol callbacks for dg.exp.
|
||||
|
||||
proc cobol-dg-test { prog do_what extra_tool_flags } {
|
||||
set result \
|
||||
[gcc-dg-test-1 cobol_target_compile $prog $do_what $extra_tool_flags]
|
||||
|
||||
set comp_output [lindex $result 0]
|
||||
set output_file [lindex $result 1]
|
||||
|
||||
return [list $comp_output $output_file]
|
||||
}
|
||||
|
||||
proc cobol-dg-prune { system text } {
|
||||
# cobol prints an extra stray error at the end when compilation fails
|
||||
regsub -all "(^|\n)cobol1: error: failed compiling \[^\n\]*" $text "" 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 cobol-dg-runtest { testcases flags default-extra-flags } {
|
||||
global runtests
|
||||
global torture_with_loops
|
||||
|
||||
# Some callers initialize torture testing themselves; don't override those.
|
||||
set existing_torture_init [torture-init-done]
|
||||
if { $existing_torture_init == 0 } {
|
||||
torture-init
|
||||
}
|
||||
# Some callers set torture options themselves; don't override those.
|
||||
set existing_torture_options [torture-options-exist]
|
||||
if { $existing_torture_options == 0 } {
|
||||
global DG_TORTURE_OPTIONS
|
||||
set-torture-options $DG_TORTURE_OPTIONS
|
||||
}
|
||||
dump-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_with_loops
|
||||
} 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}
|
||||
}
|
||||
}
|
||||
|
||||
if { $existing_torture_init == 0 } {
|
||||
torture-finish
|
||||
}
|
||||
}
|
||||
291
gcc/testsuite/lib/cobol.exp
Normal file
291
gcc/testsuite/lib/cobol.exp
Normal file
|
|
@ -0,0 +1,291 @@
|
|||
# Copyright (C) 2003-2025 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/>.
|
||||
|
||||
#
|
||||
# cobol support library routines
|
||||
#
|
||||
load_lib prune.exp
|
||||
load_lib gcc-defs.exp
|
||||
load_lib timeout.exp
|
||||
load_lib target-libpath.exp
|
||||
load_lib target-supports.exp
|
||||
|
||||
#
|
||||
# COBOL_UNDER_TEST is the compiler under test.
|
||||
#
|
||||
|
||||
|
||||
set gpp_compile_options ""
|
||||
|
||||
|
||||
#
|
||||
# cobol_version -- extract and print the version number of the compiler
|
||||
#
|
||||
|
||||
proc cobol_version { } {
|
||||
global COBOL_UNDER_TEST
|
||||
|
||||
cobol_init
|
||||
|
||||
# ignore any arguments after the command
|
||||
set compiler [lindex $COBOL_UNDER_TEST 0]
|
||||
|
||||
# verify that the compiler exists
|
||||
if { [is_remote host] || [which $compiler] != 0 } then {
|
||||
set tmp [remote_exec host "$compiler -v"]
|
||||
set status [lindex $tmp 0]
|
||||
set output [lindex $tmp 1]
|
||||
regexp " version \[^\n\r\]*" $output version
|
||||
if { $status == 0 && [info exists version] } then {
|
||||
if [is_remote host] {
|
||||
clone_output "$compiler $version\n"
|
||||
} else {
|
||||
clone_output "[which $compiler] $version\n"
|
||||
}
|
||||
} else {
|
||||
clone_output "Couldn't determine version of [which $compiler]\n"
|
||||
}
|
||||
} else {
|
||||
# compiler does not exist (this should have already been detected)
|
||||
warning "$compiler does not exist"
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# cobol_link_flags -- provide new version of cobol_link_flags
|
||||
# (originally from libgloss.exp) which knows about the gcc tree structure
|
||||
#
|
||||
|
||||
proc cobol_link_flags { paths } {
|
||||
global srcdir
|
||||
global ld_library_path
|
||||
global COBOL_UNDER_TEST
|
||||
global shlib_ext
|
||||
global ENABLE_DARWIN_AT_RPATH
|
||||
|
||||
set gccpath ${paths}
|
||||
set libio_dir ""
|
||||
set flags ""
|
||||
set ld_library_path "."
|
||||
set shlib_ext [get_shlib_extension]
|
||||
verbose "shared lib extension: $shlib_ext"
|
||||
|
||||
# We need to add options to locate libgfortran and the dependent libs
|
||||
# libquadmath (supporting REAL*16) and libatomic (supporting operations
|
||||
# used by coarrays). Usually '-L' options are added to point to the
|
||||
# relevant directories for the uninstalled libraries.
|
||||
|
||||
# In cases where libraries are available as both shared and convenience
|
||||
# some additional checks are made.
|
||||
|
||||
# For some targets -static-xxxx options are handled by specs substitution
|
||||
# and need a '-B' option rather than '-L'. For Darwin, when embedded
|
||||
# runpaths are in use (the default for all versions after macOS 10.11),
|
||||
# '-B' is also needed to provide the runpath.
|
||||
# When '-B' is used, this results in a '-L' for each path that exists (so
|
||||
# that appending a '-L' as well is a needless duplicate). There are also
|
||||
# cases where tools warn for duplicates, leading to spurious fails.
|
||||
# Therefore the objective of the code below is to add just one '-L' or
|
||||
# '-B' for each of the libraries.
|
||||
|
||||
set target_wants_B_option 0
|
||||
if { [istarget *-*-darwin9* ] || [istarget *-*-darwin\[12\]* ] } {
|
||||
set target_wants_B_option 1
|
||||
}
|
||||
|
||||
if { $gccpath != "" } {
|
||||
if [file exists "${gccpath}/libgcobol/libgcobol.a"] {
|
||||
append flags "-L${gccpath}/libgcobol"
|
||||
}
|
||||
if { [file exists "${gccpath}/libgcobol/.libs/libgcobol.a"] ||
|
||||
[file exists "${gccpath}/libgobol/.libs/libgcobol.${shlib_ext}"] } {
|
||||
if { $target_wants_B_option } {
|
||||
append flags "-B${gccpath}/libgcobol/.libs "
|
||||
} else {
|
||||
append flags "-L${gccpath}/libgcobol/.libs "
|
||||
}
|
||||
append ld_library_path ":${gccpath}/libgcobol/.libs"
|
||||
}
|
||||
if { [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.a"] ||
|
||||
[file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.${shlib_ext}"] } {
|
||||
if { $target_wants_B_option } {
|
||||
append flags "-B${gccpath}/libstdc++-v3/src/.libs "
|
||||
} else {
|
||||
append flags "-L${gccpath}/libstdc++-v3/src/.libs "
|
||||
}
|
||||
append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs"
|
||||
}
|
||||
|
||||
if [file exists "${gccpath}/libiberty/libiberty.a"] {
|
||||
append flags "-L${gccpath}/libiberty "
|
||||
}
|
||||
append ld_library_path \
|
||||
[gcc-set-multilib-library-path $COBOL_UNDER_TEST ]
|
||||
}
|
||||
|
||||
set_ld_library_path_env_vars
|
||||
|
||||
return "$flags"
|
||||
}
|
||||
|
||||
#
|
||||
# cobol_init -- called at the start of each subdir of tests
|
||||
#
|
||||
|
||||
proc cobol_init { args } {
|
||||
global subdir
|
||||
global gpp_initialized
|
||||
global base_dir
|
||||
global tmpdir
|
||||
global libdir
|
||||
global gluefile wrap_flags
|
||||
global objdir srcdir
|
||||
global ALWAYS_COBOLFLAGS
|
||||
global TOOL_EXECUTABLE TOOL_OPTIONS
|
||||
global COBOL_UNDER_TEST
|
||||
global TESTING_IN_BUILD_TREE
|
||||
global gcc_warning_prefix
|
||||
global gcc_error_prefix
|
||||
global TEST_ALWAYS_FLAGS
|
||||
global cobol_init_set_COBOL_UNDER_TEST
|
||||
|
||||
# We set LC_ALL and LANG to C so that we get the same error messages as expected.
|
||||
setenv LC_ALL C
|
||||
setenv LANG C
|
||||
|
||||
set gcc_warning_prefix "\[Ww\]arning:"
|
||||
set gcc_error_prefix "(Fatal )?\[Ee\]rror:"
|
||||
|
||||
# Many hosts now default to a non-ASCII C locale, however, so
|
||||
# they can set a charset encoding here if they need.
|
||||
if { [ishost "*-*-cygwin*"] } {
|
||||
setenv LC_ALL C.ASCII
|
||||
setenv LANG C.ASCII
|
||||
}
|
||||
|
||||
# COBOL_UNDER_TEST as set below contains $specpath, which depends on
|
||||
# the used multilib config. Thus, its value may need to be reset;
|
||||
# that's tracked via gfortran_init_set_COBOL_UNDER_TEST.
|
||||
if { ![info exists COBOL_UNDER_TEST]
|
||||
|| [info exists cobol_init_set_COBOL_UNDER_TEST] } then {
|
||||
if [info exists TOOL_EXECUTABLE] {
|
||||
set COBOL_UNDER_TEST $TOOL_EXECUTABLE
|
||||
} else {
|
||||
if { [is_remote host] || ! [info exists TESTING_IN_BUILD_TREE] } {
|
||||
set COBOL_UNDER_TEST [transform gcobol]
|
||||
} else {
|
||||
if [info exists TOOL_OPTIONS] {
|
||||
set specpath [get_multilibs ${TOOL_OPTIONS}]
|
||||
} else {
|
||||
set specpath [get_multilibs]
|
||||
}
|
||||
set cobol_init_set_COBOL_UNDER_TEST 1
|
||||
set COBOL_UNDER_TEST [findfile $base_dir/../../gcobol "$base_dir/../../gcobol -B$base_dir/../../ -B$specpath/libgcobol/.libs" [findfile $base_dir/gcobol "$base_dir/gcobol -B$base_dir/" [transform gcobol]]]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ![is_remote host] {
|
||||
if { [which $COBOL_UNDER_TEST] == 0 } then {
|
||||
perror "COBOL_UNDER_TEST ($COBOL_UNDER_TEST) does not exist"
|
||||
exit 1
|
||||
}
|
||||
}
|
||||
if ![info exists tmpdir] {
|
||||
set tmpdir "/tmp"
|
||||
}
|
||||
|
||||
if [info exists gluefile] {
|
||||
unset gluefile
|
||||
}
|
||||
|
||||
cobol_maybe_build_wrapper "${tmpdir}/cobol-testglue.o"
|
||||
|
||||
set ALWAYS_COBOLFLAGS ""
|
||||
|
||||
# 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] {
|
||||
lappend ALWAYS_COBOLFLAGS "additional_flags=$TEST_ALWAYS_FLAGS"
|
||||
}
|
||||
|
||||
if ![is_remote host] {
|
||||
if [info exists TOOL_OPTIONS] {
|
||||
lappend ALWAYS_COBOLFLAGS "ldflags=[cobol_link_flags [get_multilibs ${TOOL_OPTIONS}] ]"
|
||||
} else {
|
||||
lappend ALWAYS_COBOLFLAGS "ldflags=[cobol_link_flags [get_multilibs] ]"
|
||||
}
|
||||
}
|
||||
|
||||
if [info exists TOOL_OPTIONS] {
|
||||
lappend ALWAYS_COBOLFLAGS "additional_flags=$TOOL_OPTIONS"
|
||||
}
|
||||
|
||||
verbose -log "ALWAYS_COBOLFLAGS set to $ALWAYS_COBOLFLAGS"
|
||||
|
||||
verbose "cobol is initialized" 3
|
||||
}
|
||||
|
||||
#
|
||||
# cobol_target_compile -- compile a source file
|
||||
#
|
||||
|
||||
proc cobol_target_compile { source dest type options } {
|
||||
global tmpdir
|
||||
global gluefile wrap_flags
|
||||
global ALWAYS_COBOLFLAGS
|
||||
global COBOL_UNDER_TEST
|
||||
global TEST_ALWAYS_FLAGS
|
||||
global flags_to_postpone
|
||||
global board_info
|
||||
|
||||
if { [target_info needs_status_wrapper] != "" && [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]
|
||||
}
|
||||
|
||||
# bind_pic_locally adds -fpie/-fPIE flags to flags_to_postpone and it is
|
||||
# appended here to multilib_flags as it can be overridden by the latter
|
||||
# if it was added earlier. After the target_compile, multilib_flags is
|
||||
# restored to its orignal content.
|
||||
set tboard [target_info name]
|
||||
if {[board_info $tboard exists multilib_flags]} {
|
||||
set orig_multilib_flags "[board_info [target_info name] multilib_flags]"
|
||||
append board_info($tboard,multilib_flags) " $flags_to_postpone"
|
||||
}
|
||||
|
||||
lappend options "compiler=$COBOL_UNDER_TEST"
|
||||
lappend options "timeout=[timeout_value]"
|
||||
|
||||
set options [concat "$ALWAYS_COBOLFLAGS" $options]
|
||||
set options [dg-additional-files-options $options $source $dest $type]
|
||||
set return_val [target_compile $source $dest $type $options]
|
||||
|
||||
if {[board_info $tboard exists multilib_flags]} {
|
||||
set board_info($tboard,multilib_flags) $orig_multilib_flags
|
||||
set flags_to_postpone ""
|
||||
}
|
||||
|
||||
return $return_val
|
||||
}
|
||||
Loading…
Add table
Reference in a new issue