]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
cobol: New testcases for reference modification.
authorBob Dubner <rdubner@symas.com>
Thu, 10 Apr 2025 13:52:49 +0000 (09:52 -0400)
committerRobert Dubner <rdubner@symas.com>
Thu, 10 Apr 2025 14:10:11 +0000 (10:10 -0400)
gcc/testsuite

* cobol.dg/group2/Dynamic_reference_modification.cob: New testcase.
* cobol.dg/group2/Length_overflow__1_.cob: Likewise.
* cobol.dg/group2/Length_overflow__2_.cob: Likewise.
* cobol.dg/group2/Length_overflow_with_offset__1_.cob: Likewise.
* cobol.dg/group2/Length_overflow_with_offset__2_.cob: Likewise.
* cobol.dg/group2/Length_overflow_with_offset__3_.cob: Likewise.
* cobol.dg/group2/Offset_overflow.cob: Likewise.
* cobol.dg/group2/Offset_underflow.cob: Likewise.
* cobol.dg/group2/Refmod__comparisons_inside_numeric-display.cob: Likewise.
* cobol.dg/group2/Refmod_sources_are_figurative_constants.cob: Likewise.
* cobol.dg/group2/Static_reference_modification.cob: Likewise.
* cobol.dg/group2/Dynamic_reference_modification.out: New known-good result.
* cobol.dg/group2/Length_overflow__1_.out: Likewise.
* cobol.dg/group2/Length_overflow__2_.out: Likewise.
* cobol.dg/group2/Length_overflow_with_offset__1_.out: Likewise.
* cobol.dg/group2/Length_overflow_with_offset__2_.out: Likewise.
* cobol.dg/group2/Length_overflow_with_offset__3_.out: Likewise.
* cobol.dg/group2/Offset_overflow.out: Likewise.
* cobol.dg/group2/Offset_underflow.out: Likewise.
* cobol.dg/group2/Refmod__comparisons_inside_numeric-display.out: Likewise.
* cobol.dg/group2/Refmod_sources_are_figurative_constants.out: Likewise.
* cobol.dg/group2/Static_reference_modification.out: Likewise.

22 files changed:
gcc/testsuite/cobol.dg/group2/Dynamic_reference_modification.cob [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Dynamic_reference_modification.out [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Length_overflow__1_.cob [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Length_overflow__1_.out [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Length_overflow__2_.cob [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Length_overflow__2_.out [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.cob [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.out [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__2_.cob [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__2_.out [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__3_.cob [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__3_.out [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Offset_overflow.cob [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Offset_overflow.out [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Offset_underflow.cob [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Offset_underflow.out [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Refmod__comparisons_inside_numeric-display.cob [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Refmod__comparisons_inside_numeric-display.out [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Refmod_sources_are_figurative_constants.cob [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Refmod_sources_are_figurative_constants.out [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Static_reference_modification.cob [new file with mode: 0644]
gcc/testsuite/cobol.dg/group2/Static_reference_modification.out [new file with mode: 0644]

diff --git a/gcc/testsuite/cobol.dg/group2/Dynamic_reference_modification.cob b/gcc/testsuite/cobol.dg/group2/Dynamic_reference_modification.cob
new file mode 100644 (file)
index 0000000..99690da
--- /dev/null
@@ -0,0 +1,24 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Dynamic_reference_modification.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC X(4) VALUE "abcd".
+       01 I             PIC 9.
+       PROCEDURE        DIVISION.
+           MOVE 1 TO I.
+           DISPLAY X(I:1)
+           END-DISPLAY.
+           MOVE 4 TO I.
+           DISPLAY X(I:1)
+           END-DISPLAY.
+           MOVE 1 TO I.
+           DISPLAY X(1:I)
+           END-DISPLAY.
+           MOVE 4 TO I.
+           DISPLAY X(1:I)
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Dynamic_reference_modification.out b/gcc/testsuite/cobol.dg/group2/Dynamic_reference_modification.out
new file mode 100644 (file)
index 0000000..42a4b69
--- /dev/null
@@ -0,0 +1,5 @@
+a
+d
+a
+abcd
+
diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow__1_.cob b/gcc/testsuite/cobol.dg/group2/Length_overflow__1_.cob
new file mode 100644 (file)
index 0000000..6475356
--- /dev/null
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-xfail-run-if "" { *-*-* }  }
+       *> { dg-output-file "group2/Length_overflow__1_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC X(4) VALUE "abcd".
+       01 I             PIC 9 VALUE 5.
+       PROCEDURE        DIVISION.
+           >>TURN EC-ALL CHECKING ON
+           DISPLAY X(1:I) NO ADVANCING
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow__1_.out b/gcc/testsuite/cobol.dg/group2/Length_overflow__1_.out
new file mode 100644 (file)
index 0000000..7898192
--- /dev/null
@@ -0,0 +1 @@
+a
diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow__2_.cob b/gcc/testsuite/cobol.dg/group2/Length_overflow__2_.cob
new file mode 100644 (file)
index 0000000..351c9df
--- /dev/null
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-xfail-run-if "" { *-*-* }  }
+       *> { dg-output-file "group2/Length_overflow__2_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog2.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC X(4) VALUE "abcd".
+       01 I             PIC 9 VALUE 5.
+       PROCEDURE        DIVISION.
+           >>TURN EC-ALL CHECKING ON
+           DISPLAY X(3:I) NO ADVANCING
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow__2_.out b/gcc/testsuite/cobol.dg/group2/Length_overflow__2_.out
new file mode 100644 (file)
index 0000000..f2ad6c7
--- /dev/null
@@ -0,0 +1 @@
+c
diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.cob b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.cob
new file mode 100644 (file)
index 0000000..9f7fa83
--- /dev/null
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+       *> { dg-xfail-run-if "" { *-*-* }  }
+       *> { dg-output-file "group2/Length_overflow_with_offset__1_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC X(4) VALUE "abcd".
+       01 I             PIC 9 VALUE 3.
+       PROCEDURE        DIVISION.
+           >>TURN EC-ALL CHECKING ON
+           DISPLAY X(3:I) NO ADVANCING.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.out b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.out
new file mode 100644 (file)
index 0000000..f2ad6c7
--- /dev/null
@@ -0,0 +1 @@
+c
diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__2_.cob b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__2_.cob
new file mode 100644 (file)
index 0000000..d077373
--- /dev/null
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-xfail-run-if "" { *-*-* }  }
+       *> { dg-output-file "group2/Length_overflow_with_offset__2_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC X(4) VALUE "abcd".
+       01 I             PIC 9 VALUE 3.
+       PROCEDURE        DIVISION.
+           >>TURN EC-ALL CHECKING ON
+           IF X(3:I) <> SPACES
+              DISPLAY X(3:I) NO ADVANCING.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__2_.out b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__2_.out
new file mode 100644 (file)
index 0000000..8b13789
--- /dev/null
@@ -0,0 +1 @@
+
diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__3_.cob b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__3_.cob
new file mode 100644 (file)
index 0000000..7fa9843
--- /dev/null
@@ -0,0 +1,22 @@
+       *> { dg-do run }
+       *> { dg-xfail-run-if "" { *-*-* }  }
+       *> { dg-output-file "group2/Length_overflow_with_offset__3_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC X(4) VALUE "abcd".
+       01 I             PIC 9 VALUE 3.
+       PROCEDURE        DIVISION.
+           >>TURN EC-ALL CHECKING ON
+           EVALUATE TRUE
+           WHEN I < 2
+            AND X(3:I) <> SPACES
+              DISPLAY "1-" X(3:I) NO ADVANCING
+           WHEN I < 2
+           WHEN X(3:I) <> SPACES
+              DISPLAY "2-" X(3:I) NO ADVANCING
+           END-EVALUATE
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__3_.out b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__3_.out
new file mode 100644 (file)
index 0000000..8b13789
--- /dev/null
@@ -0,0 +1 @@
+
diff --git a/gcc/testsuite/cobol.dg/group2/Offset_overflow.cob b/gcc/testsuite/cobol.dg/group2/Offset_overflow.cob
new file mode 100644 (file)
index 0000000..8fd5421
--- /dev/null
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-xfail-run-if "" { *-*-* }  }
+       *> { dg-output-file "group2/Offset_overflow.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01.
+          03 X          PIC X(4) VALUE "abcd".
+          03 I          PIC 9 VALUE 5.
+       PROCEDURE        DIVISION.
+           >>TURN EC-ALL CHECKING ON
+           DISPLAY X(I:1) NO ADVANCING.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Offset_overflow.out b/gcc/testsuite/cobol.dg/group2/Offset_overflow.out
new file mode 100644 (file)
index 0000000..7ed6ff8
--- /dev/null
@@ -0,0 +1 @@
+5
diff --git a/gcc/testsuite/cobol.dg/group2/Offset_underflow.cob b/gcc/testsuite/cobol.dg/group2/Offset_underflow.cob
new file mode 100644 (file)
index 0000000..51100a8
--- /dev/null
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-xfail-run-if "" { *-*-* }  }
+       *> { dg-output-file "group2/Offset_underflow.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC X(4) VALUE "abcd".
+       01 I             PIC 9 VALUE 0.
+       PROCEDURE        DIVISION.
+           >>TURN EC-ALL CHECKING ON
+           DISPLAY X(I:1) NO ADVANCING
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Offset_underflow.out b/gcc/testsuite/cobol.dg/group2/Offset_underflow.out
new file mode 100644 (file)
index 0000000..7898192
--- /dev/null
@@ -0,0 +1 @@
+a
diff --git a/gcc/testsuite/cobol.dg/group2/Refmod__comparisons_inside_numeric-display.cob b/gcc/testsuite/cobol.dg/group2/Refmod__comparisons_inside_numeric-display.cob
new file mode 100644 (file)
index 0000000..6fb70f4
--- /dev/null
@@ -0,0 +1,20 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Refmod__comparisons_inside_numeric-display.out" }
+        identification division.
+        program-id. prog.
+        data division.
+        working-storage section.
+        01 n  pic 9(9).
+        01 i  pic 99.
+        procedure division.
+            perform varying i from 1 by 1 until i > 8
+            move 88888888 to n
+            move "12" to n(i:2)
+            display n
+            if n(i:2) not equal to "12"
+                display "Equality is flawed"
+                end-if
+            end-perform.
+            goback.
+         end program prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Refmod__comparisons_inside_numeric-display.out b/gcc/testsuite/cobol.dg/group2/Refmod__comparisons_inside_numeric-display.out
new file mode 100644 (file)
index 0000000..ac48dc8
--- /dev/null
@@ -0,0 +1,9 @@
+128888888
+012888888
+081288888
+088128888
+088812888
+088881288
+088888128
+088888812
+
diff --git a/gcc/testsuite/cobol.dg/group2/Refmod_sources_are_figurative_constants.cob b/gcc/testsuite/cobol.dg/group2/Refmod_sources_are_figurative_constants.cob
new file mode 100644 (file)
index 0000000..c4af57d
--- /dev/null
@@ -0,0 +1,29 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Refmod_sources_are_figurative_constants.out" }
+
+        id division.
+        program-id. prog.
+        data division.
+        working-storage section.
+        01 varx pic x(8) VALUE '""""""""'.
+        01 varp redefines varx pointer.
+        procedure division.
+        move "12345678" to varx
+        display  """" varx """"
+        move "999" to varx(4:3)
+        display  """" varx """"
+        move LOW-VALUE to varx(4:3).
+        display  """" varx """"
+        move ZERO to varx(4:3).
+        display  """" varx """"
+        move SPACE to varx(4:3).
+        display  """" varx """"
+        move QUOTE to varx(4:3).
+        display  """" varx """"
+        move HIGH-VALUE to varx(4:3).
+        display  varp
+        initialize varx all to value
+        display  """" varx """"
+        .
+        end program prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Refmod_sources_are_figurative_constants.out b/gcc/testsuite/cobol.dg/group2/Refmod_sources_are_figurative_constants.out
new file mode 100644 (file)
index 0000000..2f5dadc
--- /dev/null
@@ -0,0 +1,9 @@
+"12345678"
+"12399978"
+"123"
+"12300078"
+"123   78"
+"123"""78"
+0x3837ffffff333231
+""""""""""
+
diff --git a/gcc/testsuite/cobol.dg/group2/Static_reference_modification.cob b/gcc/testsuite/cobol.dg/group2/Static_reference_modification.cob
new file mode 100644 (file)
index 0000000..919ddb3
--- /dev/null
@@ -0,0 +1,19 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Static_reference_modification.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC X(4) VALUE "abcd".
+       PROCEDURE        DIVISION.
+           DISPLAY X(1:1) ":" X(1:2) ":" X(1:3) ":" X(1:4) ":" X(1:)
+           END-DISPLAY.
+           DISPLAY X(2:1) ":" X(2:2) ":" X(2:3) ":" X(2:)
+           END-DISPLAY.
+           DISPLAY X(3:1) ":" X(3:2) ":" X(3:)
+           END-DISPLAY.
+           DISPLAY X(4:1) ":" X(4:)
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Static_reference_modification.out b/gcc/testsuite/cobol.dg/group2/Static_reference_modification.out
new file mode 100644 (file)
index 0000000..fe51165
--- /dev/null
@@ -0,0 +1,5 @@
+a:ab:abc:abcd:abcd
+b:bc:bcd:bcd
+c:cd:cd
+d:d
+