This works on a x86_64-linux machine, although I had to do a complete rebuild to make it take.
If this meets with the approval of the global reviewers, please apply it, with a suitable commit message. The main characteristic of my trying to cope with modifying my workflow and coping with the GCC server and our COBOLWORX server, and understanding how ChangeLog entries get created has resulted in my finding new and marvelous ways of tying my shoelaces together. I'll get the hang of it. But I have spent hours and hours sorting out the infrastructure, after having spent about an hour creating this new-ish code. Although I wouldn't want to have to explain just how much of that hour was spent figuring out that ----*---- had to be replaced with ----\[*\]----. diff --git a/gcc/testsuite/cobol.dg/group1/check_88.cob b/gcc/testsuite/cobol.dg/group1/check_88.cob new file mode 100644 index 00000000000..b29fe626af6 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group1/check_88.cob @@ -0,0 +1,116 @@ +*> { dg-do run } +*> { dg-output "-><-\n" } +*> { dg-output "-> <-\n" } +*> { dg-output "->\"\"\"<-\n" } +*> { dg-output "->000<-\n" } +*> { dg-output "->ÿÿÿ<-\n" } +*> { dg-output " \n" } +*> { dg-output "-><-\n" } +*> { dg-output "-> <-\n" } +*> { dg-output "->\"\"\"\"<-\n" } +*> { dg-output "->0000<-\n" } +*> { dg-output "->ÿÿÿÿ<-\n" } +*> { dg-output " \n" } +*> { dg-output "There should be no garbage after character 32\n" } +*> { dg-output "-------------------------------\[*\]--------------------------------\n" } +*> { dg-output "üüüüüüüüüüüüüüüüüüü Bundesstraße \n" } +*> { dg-output "üüüüüüüüüüüüüüüüüüü Bundesstraße \n" } +*> { dg-output " \n" } +*> { dg-output "There should be no spaces before the final quote\n" } +*> { dg-output "\"üüüüüüüüüüüüüüüüüüü Bundesstraße\"\n" } +*> { dg-output " \n" } +*> { dg-output " IsLow \"\"\n" } +*> { dg-output " IsZero \"000\"\n" } +*> { dg-output " IsHi \"ÿÿÿ\"\n" } +*> { dg-output " IsBob \"bob\"\n" } +*> { dg-output " IsQuote \"\"\"\"\"\n" } +*> { dg-output " IsSpace \" \"\n" } +*> { dg-output " \n" } +*> { dg-output "CheckBinary Properly True\n" } +*> { dg-output "CheckBinary Properly False\n" } + IDENTIFICATION DIVISION. + PROGRAM-ID. check88. + + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Check88 PIC XXX VALUE SPACE. + 88 CheckSpace VALUE SPACE. + 88 CheckHi VALUE HIGH-VALUES. + 88 CheckLo VALUE LOW-VALUES. + 88 CheckZero VALUE ZERO. + 88 CheckQuotes VALUE QUOTE. + 88 CheckBob VALUE "bob". + 88 CheckBinary VALUE X"000102". *> { dg-warning .*embedded.* } + + 01 000VARL PIC XXX VALUE LOW-VALUE. + 01 000VARS PIC XXX VALUE SPACE. + 01 000VARQ PIC XXX VALUE QUOTE. + 01 000VARZ PIC XXX VALUE ZERO. + 01 000VARH PIC XXX VALUE HIGH-VALUE. + + 01 MOVE-TARGET PIC XXXX. + + 01 VAR-UTF8 PIC X(64) VALUE "üüüüüüüüüüüüüüüüüüü Bundesstraße". + + *> 01 VAR20 PIC 9V9(20) value "1.1". + + 01 VAR99 PIC 999 VALUE ZERO. + + PROCEDURE DIVISION. + DISPLAY "->" 000VARL "<-" + DISPLAY "->" 000VARS "<-" + DISPLAY "->" 000VARQ "<-" + DISPLAY "->" 000VARZ "<-" + DISPLAY "->" 000VARH "<-" + DISPLAY SPACE + + MOVE LOW-VALUE TO MOVE-TARGET DISPLAY "->" MOVE-TARGET "<-" + MOVE SPACE TO MOVE-TARGET DISPLAY "->" MOVE-TARGET "<-" + MOVE QUOTE TO MOVE-TARGET DISPLAY "->" MOVE-TARGET "<-" + MOVE ZERO TO MOVE-TARGET DISPLAY "->" MOVE-TARGET "<-" + MOVE HIGH-VALUE TO MOVE-TARGET DISPLAY "->" MOVE-TARGET "<-" + DISPLAY SPACE + + DISPLAY "There should be no garbage after character 32" + DISPLAY "-------------------------------*" + "--------------------------------" + DISPLAY VAR-UTF8 + MOVE "üüüüüüüüüüüüüüüüüüü Bundesstraße" TO VAR-UTF8 + DISPLAY VAR-UTF8 + DISPLAY SPACE + + DISPLAY "There should be no spaces before the final quote" + DISPLAY """" "üüüüüüüüüüüüüüüüüüü Bundesstraße" """" + DISPLAY SPACE + + + SET CheckLo to TRUE PERFORM Checker DISPLAY """" Check88 """" + SET CheckZero to TRUE PERFORM Checker DISPLAY """" Check88 """" + SET CheckHi to TRUE PERFORM Checker DISPLAY """" Check88 """" + SET CheckBob to TRUE PERFORM Checker DISPLAY """" Check88 """" + SET CheckQuotes to TRUE PERFORM Checker DISPLAY """" Check88 """" + SET CheckSpace to TRUE PERFORM Checker DISPLAY """" Check88 """" + DISPLAY SPACE + + MOVE X"000102" TO Check88 + IF CheckBinary + DISPLAY "CheckBinary Properly True" + else + DISPLAY "CheckBinary IMPROPERLY False". + MOVE X"030102" TO Check88 + IF CheckBinary + DISPLAY "CheckBinary IMPROPERLY True" + else + DISPLAY "CheckBinary Properly False". + + STOP RUN. + + Checker. + *>DISPLAY "Checking '" Check88 "'" + IF CheckHi DISPLAY " IsHi " NO ADVANCING END-IF + IF CheckLo DISPLAY " IsLow " NO ADVANCING END-IF + IF CheckZero DISPLAY " IsZero " NO ADVANCING END-IF + IF CheckBob DISPLAY " IsBob " NO ADVANCING END-IF + IF CheckQuotes DISPLAY " IsQuote " NO ADVANCING END-IF + IF CheckSpace DISPLAY " IsSpace " NO ADVANCING END-IF + . diff --git a/gcc/testsuite/cobol.dg/group1/dg.exp b/gcc/testsuite/cobol.dg/group1/dg.exp new file mode 100644 index 00000000000..e75e3ab1895 --- /dev/null +++ b/gcc/testsuite/cobol.dg/group1/dg.exp @@ -0,0 +1,43 @@ +# 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. +if [check_effective_target_cobol] { + cobol-dg-runtest [lsort \ + [glob -nocomplain $srcdir/$subdir/*.cob ] ] "" $all_flags +} + +# All done. +dg-finish