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

Reply via email to