https://gcc.gnu.org/g:6ddcbb3ec8cf5e0ab38c28f40e92e0a77d6f1fdd
commit r15-9363-g6ddcbb3ec8cf5e0ab38c28f40e92e0a77d6f1fdd
Author: Bob Dubner <rdub...@symas.com>
Date: Thu Apr 10 09:52:49 2025 -0400
cobol: New testcases for reference modification.
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.
Diff:
---
.../group2/Dynamic_reference_modification.cob | 24 ++++++++++++++++++
.../group2/Dynamic_reference_modification.out | 5 ++++
.../cobol.dg/group2/Length_overflow__1_.cob | 16 ++++++++++++
.../cobol.dg/group2/Length_overflow__1_.out | 1 +
.../cobol.dg/group2/Length_overflow__2_.cob | 16 ++++++++++++
.../cobol.dg/group2/Length_overflow__2_.out | 1 +
.../group2/Length_overflow_with_offset__1_.cob | 15 +++++++++++
.../group2/Length_overflow_with_offset__1_.out | 1 +
.../group2/Length_overflow_with_offset__2_.cob | 16 ++++++++++++
.../group2/Length_overflow_with_offset__2_.out | 1 +
.../group2/Length_overflow_with_offset__3_.cob | 22 ++++++++++++++++
.../group2/Length_overflow_with_offset__3_.out | 1 +
gcc/testsuite/cobol.dg/group2/Offset_overflow.cob | 16 ++++++++++++
gcc/testsuite/cobol.dg/group2/Offset_overflow.out | 1 +
gcc/testsuite/cobol.dg/group2/Offset_underflow.cob | 16 ++++++++++++
gcc/testsuite/cobol.dg/group2/Offset_underflow.out | 1 +
.../Refmod__comparisons_inside_numeric-display.cob | 20 +++++++++++++++
.../Refmod__comparisons_inside_numeric-display.out | 9 +++++++
.../Refmod_sources_are_figurative_constants.cob | 29 ++++++++++++++++++++++
.../Refmod_sources_are_figurative_constants.out | 9 +++++++
.../group2/Static_reference_modification.cob | 19 ++++++++++++++
.../group2/Static_reference_modification.out | 5 ++++
22 files changed, 244 insertions(+)
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
index 000000000000..99690da57327
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Dynamic_reference_modification.cob
@@ -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
index 000000000000..42a4b69544ec
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Dynamic_reference_modification.out
@@ -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
index 000000000000..647535675756
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Length_overflow__1_.cob
@@ -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
index 000000000000..78981922613b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Length_overflow__1_.out
@@ -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
index 000000000000..351c9df606b2
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Length_overflow__2_.cob
@@ -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
index 000000000000..f2ad6c76f011
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Length_overflow__2_.out
@@ -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
index 000000000000..9f7fa835b6db
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.cob
@@ -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
index 000000000000..f2ad6c76f011
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__1_.out
@@ -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
index 000000000000..d0773738b0d2
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__2_.cob
@@ -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
index 000000000000..8b137891791f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__2_.out
@@ -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
index 000000000000..7fa98436c057
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__3_.cob
@@ -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
index 000000000000..8b137891791f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Length_overflow_with_offset__3_.out
@@ -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
index 000000000000..8fd5421a69d9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Offset_overflow.cob
@@ -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
index 000000000000..7ed6ff82de6b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Offset_overflow.out
@@ -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
index 000000000000..51100a884b9e
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Offset_underflow.cob
@@ -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
index 000000000000..78981922613b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Offset_underflow.out
@@ -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
index 000000000000..6fb70f475fee
--- /dev/null
+++
b/gcc/testsuite/cobol.dg/group2/Refmod__comparisons_inside_numeric-display.cob
@@ -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
index 000000000000..ac48dc84057e
--- /dev/null
+++
b/gcc/testsuite/cobol.dg/group2/Refmod__comparisons_inside_numeric-display.out
@@ -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
index 000000000000..c4af57dda0a8
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Refmod_sources_are_figurative_constants.cob
@@ -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
index 000000000000..2f5dadc5365a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Refmod_sources_are_figurative_constants.out
@@ -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
index 000000000000..919ddb3116a1
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Static_reference_modification.cob
@@ -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
index 000000000000..fe5116551da4
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Static_reference_modification.out
@@ -0,0 +1,5 @@
+a:ab:abc:abcd:abcd
+b:bc:bcd:bcd
+c:cd:cd
+d:d
+
