diff mbox series

cobol: add check_88.cob testcase

Message ID 03f401db96d8$27de6430$779b2c90$@symas.com
State New
Headers show
Series cobol: add check_88.cob testcase | expand

Commit Message

Robert Dubner March 17, 2025, 1:01 a.m. UTC 
This is a second attempt at this program.

This one was created by a Python program.  It accessed the cobolworx.com
git repository gcc/cobol/tests/check_88/, pulled out the .cbl source and
the known-good.txt files, and combined them.  I had to edit it slightly to
handle the warning that code generates.

Okay for trunk?

From 4cf1d86aab58baab0ea0e7ff3891f5c908b9726c Mon Sep 17 00:00:00 2001
From: Bob Dubner <rdubner@symas.com>
Date: Sun, 16 Mar 2025 20:48:10 -0400
Subject: [PATCH] cobol: add check_88.cob testcase

gcc/testsuite

	* cobol.dg/group1/check_88.cob: New testcase.
---
 gcc/testsuite/cobol.dg/group1/check_88.cob | 117 +++++++++++++++++++++
 1 file changed, 117 insertions(+)
 create mode 100644 gcc/testsuite/cobol.dg/group1/check_88.cob

+
+        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
+            .
+
--
2.34.1
diff mbox series

Patch

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 000000000000..3315a4838740
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group1/check_88.cob
@@ -0,0 +1,117 @@ 
+*> { dg-do run }
+*> { dg-output {\-><\-(\n|\r|\r\n)} }
+*> { dg-output {\->   <\-(\n|\r|\r\n)} }
+*> { dg-output {\->"""<\-(\n|\r|\r\n)} }
+*> { dg-output {\->000<\-(\n|\r|\r\n)} }
+*> { dg-output {\->ÿÿÿ<\-(\n|\r|\r\n)} }
+*> { dg-output { (\n|\r|\r\n)} }
+*> { dg-output {\-><\-(\n|\r|\r\n)} }
+*> { dg-output {\->    <\-(\n|\r|\r\n)} }
+*> { dg-output {\->""""<\-(\n|\r|\r\n)} }
+*> { dg-output {\->0000<\-(\n|\r|\r\n)} }
+*> { dg-output {\->ÿÿÿÿ<\-(\n|\r|\r\n)} }
+*> { dg-output { (\n|\r|\r\n)} }
+*> { dg-output {There should be no garbage after character
32(\n|\r|\r\n)} }
+*> { dg-output
{\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\*\-\-\-\-\
-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-(\n|\r|\r\n)} }
+*> { dg-output {üüüüüüüüüüüüüüüüüüü Bundesstraße
(\n|\r|\r\n)} }
+*> { dg-output {üüüüüüüüüüüüüüüüüüü Bundesstraße
(\n|\r|\r\n)} }
+*> { dg-output { (\n|\r|\r\n)} }
+*> { dg-output {There should be no spaces before the final
quote(\n|\r|\r\n)} }
+*> { dg-output {"üüüüüüüüüüüüüüüüüüü Bundesstraße"(\n|\r|\r\n)} }
+*> { dg-output { (\n|\r|\r\n)} }
+*> { dg-output {   IsLow   ""(\n|\r|\r\n)} }
+*> { dg-output {   IsZero  "000"(\n|\r|\r\n)} }
+*> { dg-output {   IsHi    "ÿÿÿ"(\n|\r|\r\n)} }
+*> { dg-output {   IsBob   "bob"(\n|\r|\r\n)} }
+*> { dg-output {   IsQuote """""(\n|\r|\r\n)} }
+*> { dg-output {   IsSpace "   "(\n|\r|\r\n)} }
+*> { dg-output { (\n|\r|\r\n)} }
+*> { dg-output {CheckBinary Properly True(\n|\r|\r\n)} }
+*> { dg-output {CheckBinary Properly False} }
+        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.