cobol: New testcases.

author Robert Dubner <rdubner@symas.com>

Sun, 11 May 2025 13:40:41 +0000 (09:40 -0400)

committer Robert Dubner <rdubner@symas.com>

Tue, 29 Jul 2025 16:06:38 +0000 (12:06 -0400)
author Robert Dubner <rdubner@symas.com>
Sun, 11 May 2025 13:40:41 +0000 (09:40 -0400)
committer Robert Dubner <rdubner@symas.com>
Tue, 29 Jul 2025 16:06:38 +0000 (12:06 -0400)
diff --git a/gcc/testsuite/cobol.dg/group2/258_Nested_PERFORM.cob b/gcc/testsuite/cobol.dg/group2/258_Nested_PERFORM.cob

new file mode 100644 (file)

index 0000000..383cd0a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/258_Nested_PERFORM.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/258_Nested_PERFORM.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       PROCEDURE        DIVISION.
+           PERFORM 2 TIMES
+             DISPLAY "X" NO ADVANCING
+             END-DISPLAY
+             PERFORM 2 TIMES
+               DISPLAY "Y" NO ADVANCING
+               END-DISPLAY
+             END-PERFORM
+           END-PERFORM.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/258_Nested_PERFORM.out b/gcc/testsuite/cobol.dg/group2/258_Nested_PERFORM.out

new file mode 100644 (file)

index 0000000..3c3d159
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/258_Nested_PERFORM.out
@@ -0,0 +1 @@
+XYYXYY
diff --git a/gcc/testsuite/cobol.dg/group2/259_PERFORM_VARYING_BY_-0.2.cob b/gcc/testsuite/cobol.dg/group2/259_PERFORM_VARYING_BY_-0.2.cob

new file mode 100644 (file)

index 0000000..295caf5
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/259_PERFORM_VARYING_BY_-0.2.cob
@@ -0,0 +1,19 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/259_PERFORM_VARYING_BY_-0.2.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+          77 X             PIC 9v9.
+       PROCEDURE        DIVISION.
+           PERFORM VARYING X FROM 0.8 BY -0.2
+                   UNTIL   X < 0.4
+             DISPLAY "X" NO ADVANCING
+             END-DISPLAY
+           END-PERFORM.
+       IF X NOT = 0.2
+         DISPLAY "WRONG X: " X END-DISPLAY
+       END-IF
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/259_PERFORM_VARYING_BY_-0.2.out b/gcc/testsuite/cobol.dg/group2/259_PERFORM_VARYING_BY_-0.2.out

new file mode 100644 (file)

index 0000000..dd6d86a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/259_PERFORM_VARYING_BY_-0.2.out
@@ -0,0 +1 @@
+XXX
diff --git a/gcc/testsuite/cobol.dg/group2/338_Default_Arithmetic__1_.cob b/gcc/testsuite/cobol.dg/group2/338_Default_Arithmetic__1_.cob

new file mode 100644 (file)

index 0000000..5405dba
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/338_Default_Arithmetic__1_.cob
@@ -0,0 +1,75 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/338_Default_Arithmetic__1_.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01 NUM-A   PIC 9(3) VALUE 399.
+       01 NUM-B   PIC 9(3) VALUE 211.
+       01 NUM-C   PIC 9(3)V99 VALUE 212.34.
+       01 NUMV1   PIC 9(3)V9.
+       01 PICX    PIC X VALUE 'A'.
+       01 RSLT    PIC 9(3).
+       01 RSLTV1  PIC 9(3).9.
+       01 RSLTV2  PIC 9(3).99.
+      *
+       PROCEDURE DIVISION.
+       MAIN.
+           COMPUTE RSLT = NUM-A + 1.1.
+           DISPLAY 'Simple Compute  RSLT IS ' RSLT
+           COMPUTE RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100
+           DISPLAY 'Single Variable RSLT IS ' RSLT
+           COMPUTE RSLTV2, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100
+           DISPLAY 'Compute  RSLT    IS ' RSLT
+           DISPLAY 'Compute  RSLTv99 IS ' RSLTV2
+           COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100
+           DISPLAY 'Compute  RSLT    IS ' RSLT
+           DISPLAY 'Compute  RSLTv9  IS ' RSLTV1
+           MOVE 0 TO RSLT
+           ADD NUM-C TO RSLT.
+           DISPLAY 'Add      RSLT    IS ' RSLT.
+           MOVE 0 TO RSLT
+           ADD NUM-A NUM-C 10 TO RSLT.
+           DISPLAY 'Add      RSLT    IS ' RSLT.
+           SUBTRACT NUM-C FROM RSLT.
+           DISPLAY 'Subtract RSLT    IS ' RSLT.
+           SUBTRACT NUM-A -10 FROM RSLT.
+           DISPLAY 'Subtract RSLT    IS ' RSLT.
+           MOVE 0 TO RSLT
+           ADD NUM-A NUM-C TO RSLT GIVING RSLTV1.
+           DISPLAY 'Add      RSLTv9  IS ' RSLTV1
+           MULTIPLY NUM-A BY NUM-C GIVING RSLT.
+           DISPLAY 'Multiply RSLT    IS ' RSLT.
+           MULTIPLY RSLT BY NUM-C.
+           DISPLAY 'Multiply RSLT    IS ' RSLT.
+           DIVIDE NUM-A BY 10 GIVING RSLT.
+           DISPLAY 'Divide   RSLT    IS ' RSLT.
+           DIVIDE RSLT BY 4 GIVING RSLTV1.
+           DISPLAY 'Divide   RSLTv9  IS ' RSLTV1.
+           DIVIDE RSLT BY 4 GIVING RSLT.
+           DISPLAY 'Divide   RSLT    IS ' RSLT.
+
+           COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100
+           DISPLAY 'Simple   RSLT    IS ' RSLT
+                           ' RSLTv9  IS ' RSLTV1.
+
+           COMPUTE RSLTV1, RSLT = ((NUM-A / (100.55 + -0.550))
+                                -  (NUM-B / (10.11 * 10 - 1.1)))
+                                  * (220 / 2.2)
+           DISPLAY 'Complex  RSLT    IS ' RSLT
+                           ' RSLTv9  IS ' RSLTV1.
+
+           COMPUTE RSLTV1, RSLT = ((NUM-A / (101 - 1))
+                                -  (NUM-B / (10 * 10))) * (200 / 2)
+           DISPLAY 'Reduced  RSLT    IS ' RSLT
+                           ' RSLTv9  IS ' RSLTV1.
+           MOVE NUM-A TO NUMV1.
+           IF ((NUMV1 / (101 - 1))
+              -  (NUM-B / (10 * 10))) * (200 / 2) EQUAL 188
+              DISPLAY "Not Using ARITHMETIC-OSVS"
+           ELSE
+              DISPLAY "Using ARITHMETIC-OSVS"
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/338_Default_Arithmetic__1_.out b/gcc/testsuite/cobol.dg/group2/338_Default_Arithmetic__1_.out

new file mode 100644 (file)

index 0000000..3137fc4
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/338_Default_Arithmetic__1_.out
@@ -0,0 +1,21 @@
+Simple Compute  RSLT IS 400
+Single Variable RSLT IS 188
+Compute  RSLT    IS 188
+Compute  RSLTv99 IS 188.00
+Compute  RSLT    IS 188
+Compute  RSLTv9  IS 188.0
+Add      RSLT    IS 212
+Add      RSLT    IS 621
+Subtract RSLT    IS 408
+Subtract RSLT    IS 019
+Add      RSLTv9  IS 611.3
+Multiply RSLT    IS 723
+Multiply RSLT    IS 723
+Divide   RSLT    IS 039
+Divide   RSLTv9  IS 009.7
+Divide   RSLT    IS 009
+Simple   RSLT    IS 188 RSLTv9  IS 188.0
+Complex  RSLT    IS 188 RSLTv9  IS 188.0
+Reduced  RSLT    IS 188 RSLTv9  IS 188.0
+Not Using ARITHMETIC-OSVS
+
diff --git a/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rule_8_OPTION_INITIALIZE_with_figconst.cob b/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rule_8_OPTION_INITIALIZE_with_figconst.cob

new file mode 100644 (file)

index 0000000..6fab992
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rule_8_OPTION_INITIALIZE_with_figconst.cob
@@ -0,0 +1,113 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/ALLOCATE_Rule_8_OPTION_INITIALIZE_with_figconst.out" }
+
+        identification          division.
+        program-id.             prog.
+        procedure               division.
+        display "initialize zeroes"
+            call                    "prog-zeroes"
+        display "initialize low-value"
+            call                    "prog-low"
+        display "initialize spaces"
+            call                    "prog-space"
+        display "initialize high-value"
+            call                    "prog-high"
+        continue.
+        end program             prog.
+
+        identification          division.
+        program-id.             prog-space.
+        options. initialize working-storage spaces.
+        data                    division.
+        working-storage         section.
+        01   based-var          based.
+         02  based-x            pic x(24) value "I am I, Don Quixote".
+         02  based-9            pic 999   value 123.
+         02  based-p            pointer   value NULL.
+        01   allocated-pointer  pointer.
+        procedure division.
+        display     "allocate characters  (ISO 2023 Rule 8: OPT_INIT if specified, otherwise defaultbyte, otherwise zero)"
+        allocate 35 characters returning allocated-pointer
+        set address of based-var to allocated-pointer
+        call        "reporter" using based-var
+        free        allocated-pointer
+        goback.
+        end program             prog-space.
+
+        identification          division.
+        program-id.             prog-low.
+        options. initialize working-storage low-values.
+        data                    division.
+        working-storage         section.
+        01   based-var          based.
+         02  based-x            pic x(24) value "I am I, Don Quixote".
+         02  based-9            pic 999   value 123.
+         02  based-p            pointer   value NULL.
+        01   allocated-pointer  pointer.
+        procedure division.
+        display     "allocate characters  (ISO 2023 Rule 8: OPT_INIT if specified, otherwise defaultbyte, otherwise zero)"
+        allocate 35 characters returning allocated-pointer
+        set address of based-var to allocated-pointer
+        call        "reporter" using based-var
+        free        allocated-pointer
+        goback.
+        end program             prog-low.
+
+        identification          division.
+        program-id.             prog-zeroes.
+        options. initialize working-storage binary zeroes.
+        data                    division.
+        working-storage         section.
+        01   based-var          based.
+         02  based-x            pic x(24) value "I am I, Don Quixote".
+         02  based-9            pic 999   value 123.
+         02  based-p            pointer   value NULL.
+        01   allocated-pointer  pointer.
+        procedure division.
+        display     "allocate characters  (ISO 2023 Rule 8: OPT_INIT if specified, otherwise defaultbyte, otherwise zero)"
+        allocate 35 characters returning allocated-pointer
+        set address of based-var to allocated-pointer
+        call        "reporter" using based-var
+        free        allocated-pointer
+        goback.
+        end program             prog-zeroes.
+
+        identification          division.
+        program-id.             prog-high.
+        options. initialize working-storage high-values.
+        data                    division.
+        working-storage         section.
+        01   based-var          based.
+         02  based-x            pic x(24) value "I am I, Don Quixote".
+         02  based-9            pic 999   value 123.
+         02  based-p            pointer   value NULL.
+        01   allocated-pointer  pointer.
+        procedure division.
+        display     "allocate characters  (ISO 2023 Rule 8: OPT_INIT if specified, otherwise defaultbyte, otherwise zero)"
+        allocate 35 characters returning allocated-pointer
+        set address of based-var to allocated-pointer
+        call        "reporter" using based-var
+        free        allocated-pointer
+        goback.
+        end program             prog-high.
+
+        identification          division.
+        program-id.             reporter.
+        data                    division.
+        linkage                 section.
+        01   based-var          based.
+         02  based-x            pic x(24).
+         02  based-9            pic 999  .
+         02  based-p            pointer  .
+        procedure division      using based-var.
+        reportt.
+            display "   (1) as allocated"
+            perform reportt2
+            goback.
+        reportt2.
+            display "       " """" based-x """" with no advancing
+            display space     """" based-9 """" with no advancing
+            display space       based-p.
+            continue.
+        end program             reporter.
+
diff --git a/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rule_8_OPTION_INITIALIZE_with_figconst.out b/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rule_8_OPTION_INITIALIZE_with_figconst.out

new file mode 100644 (file)

index 0000000..c141fdf
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ALLOCATE_Rule_8_OPTION_INITIALIZE_with_figconst.out
@@ -0,0 +1,17 @@
+initialize zeroes
+allocate characters  (ISO 2023 Rule 8: OPT_INIT if specified, otherwise defaultbyte, otherwise zero)
+   (1) as allocated
+       "" "" 0x0000000000000000
+initialize low-value
+allocate characters  (ISO 2023 Rule 8: OPT_INIT if specified, otherwise defaultbyte, otherwise zero)
+   (1) as allocated
+       "" "" 0x0000000000000000
+initialize spaces
+allocate characters  (ISO 2023 Rule 8: OPT_INIT if specified, otherwise defaultbyte, otherwise zero)
+   (1) as allocated
+       "                        " "   " 0x2020202020202020
+initialize high-value
+allocate characters  (ISO 2023 Rule 8: OPT_INIT if specified, otherwise defaultbyte, otherwise zero)
+   (1) as allocated
+       "ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ" "¿¿¿" 0xffffffffffffffff
+
diff --git a/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_basic_default_versions.cob b/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_basic_default_versions.cob

new file mode 100644 (file)

index 0000000..abcba96
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_basic_default_versions.cob
@@ -0,0 +1,73 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/ALLOCATE___FREE_basic_default_versions.out" }
+
+        program-id.         prog.
+        data                division.
+        working-storage     section.
+        01 based-var        pic x(100) based.
+        01 mem-pointer      pointer.
+        01 mem-size         pic 999 value 100.
+        01 counter          pic 99 value zero.
+        procedure division.
+        allocate 100        characters returning mem-pointer.
+            if mem-pointer equal NULL
+                display "allocate 100 should not be NULL (1)"
+            else
+                add 1 to counter.
+        free mem-pointer
+            if mem-pointer not equal NULL
+                display "mem-pointer should be NULL again (1)"
+            else
+                add 1 to counter.
+
+        allocate mem-size   characters returning mem-pointer.
+            if mem-pointer equal null
+                display "allocate mem-size should not be NULL (2)"
+            else
+                add 1 to counter.
+        free mem-pointer
+            if mem-pointer not equal null
+                display "mem-pointer should be NULL again (2)"
+            else
+                add 1 to counter.
+
+        allocate based-var
+            if address of based-var equal NULL
+                display "address of based-var should not be NULL (1)"
+            else
+                add 1 to counter
+        free based-var
+            if address of based-var not equal NULL
+                display "address of based-var be NULL (1)"
+            else
+                add 1 to counter.
+
+        allocate based-var
+            if address of based-var equal NULL
+                display "address of based-var should not be NULL (2)"
+            else
+                add 1 to counter.
+        free address of based-var
+            if address of based-var not equal NULL
+                display "address of based-var be NULL (2)"
+            else
+                add 1 to counter.
+
+        allocate based-var returning mem-pointer.
+        if address of based-var equal NULL
+            display "address of based-var should not be NULL (3)"
+        else
+            add 1 to counter.
+        if mem-pointer equal NULL
+            display "address of mem-pointer should not be NULL (3)"
+        else
+            add 1 to counter.
+        if address of based-var not equal mem-pointer
+            display "address of mem-pointer should be equal to mem-pointer (3)"
+        else
+            add 1 to counter.
+
+        display "There were " counter " successful tests; should be 11."
+        goback.
+        end program prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_basic_default_versions.out b/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_basic_default_versions.out

new file mode 100644 (file)

index 0000000..ab96696
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_basic_default_versions.out
@@ -0,0 +1,2 @@
+There were 11 successful tests; should be 11.
+
diff --git a/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_with_BASED_item__1_.cob b/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_with_BASED_item__1_.cob

new file mode 100644 (file)

index 0000000..b4929b8
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_with_BASED_item__1_.cob
@@ -0,0 +1,18 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       LINKAGE          SECTION.
+       01  MYFLD        PIC X(6) BASED VALUE "ABCDEF".
+       PROCEDURE        DIVISION.
+       ASTART SECTION.
+       A01.
+           ALLOCATE MYFLD INITIALIZED.
+           IF MYFLD NOT = "ABCDEF"
+              DISPLAY MYFLD
+              END-DISPLAY
+           END-IF.
+           FREE ADDRESS OF MYFLD.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_with_BASED_item__2_.cob b/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_with_BASED_item__2_.cob

new file mode 100644 (file)

index 0000000..9820784
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_with_BASED_item__2_.cob
@@ -0,0 +1,35 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 MYFLD         BASED.
+             03 MYFLDX  PIC X.
+             03 MYFLD9  PIC 9.
+       PROCEDURE        DIVISION.
+           IF ADDRESS OF MYFLD NOT = NULL
+              DISPLAY "BASED ITEM WITH ADDRESS ON START"
+              END-DISPLAY
+           END-IF.
+           FREE MYFLD.
+           ALLOCATE MYFLD.
+           IF ADDRESS OF MYFLD = NULL
+              DISPLAY "BASED ITEM WITHOUT ADDRESS AFTER ALLOCATE"
+              END-DISPLAY
+           END-IF.
+           INITIALIZE MYFLD.
+           IF MYFLD NOT = " 0"
+              DISPLAY "BASED ITEM INITIALIZED WRONG: "
+                 WITH NO ADVANCING
+              END-DISPLAY
+              DISPLAY MYFLD
+              END-DISPLAY
+           END-IF.
+
+           FREE ADDRESS OF MYFLD.
+           IF ADDRESS OF MYFLD NOT = NULL
+              DISPLAY "BASED ITEM WITH ADDRESS AFTER FREE"
+              END-DISPLAY
+           END-IF.
+
diff --git a/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__1_.cob b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__1_.cob

new file mode 100644 (file)

index 0000000..a4dc2e5
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__1_.cob
@@ -0,0 +1,27 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/ANY_LENGTH__1_.out" }
+
+        IDENTIFICATION   DIVISION.
+        PROGRAM-ID.      caller.
+        DATA             DIVISION.
+        WORKING-STORAGE  SECTION.
+        01 P1            PIC X(6) VALUE "OKOKOK".
+        PROCEDURE        DIVISION.
+            CALL "callee" USING P1
+            END-CALL.
+            STOP RUN.
+        IDENTIFICATION   DIVISION.
+        PROGRAM-ID.      callee.
+        DATA             DIVISION.
+        WORKING-STORAGE  SECTION.
+        01 P2            PIC 99.
+        LINKAGE          SECTION.
+        01 P1            PIC X ANY LENGTH.
+        PROCEDURE        DIVISION USING P1.
+            MOVE FUNCTION LENGTH (P1) TO P2.
+            DISPLAY "The incoming ANY LENGTH is " P2
+            DISPLAY "The incoming ANY LENGTH variable is " """" P1 """"
+            EXIT PROGRAM.
+        END PROGRAM callee.
+        END PROGRAM caller.
+
diff --git a/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__1_.out b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__1_.out

new file mode 100644 (file)

index 0000000..f35acf2
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__1_.out
@@ -0,0 +1,3 @@
+The incoming ANY LENGTH is 06
+The incoming ANY LENGTH variable is "OKOKOK"
+
diff --git a/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__2_.cob b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__2_.cob

new file mode 100644 (file)

index 0000000..8f152eb
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__2_.cob
@@ -0,0 +1,33 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/ANY_LENGTH__2_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      caller.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 P1            PIC X(2) VALUE "OK".
+       PROCEDURE        DIVISION.
+           CALL "callee" USING P1
+           END-CALL.
+           DISPLAY "On return, P1 is " """" P1 """"
+           STOP RUN.
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      callee.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 P2            PIC XXX.
+       LINKAGE          SECTION.
+       01 P1            PIC X ANY LENGTH.
+       PROCEDURE        DIVISION USING P1.
+           MOVE P1 TO P2.
+           DISPLAY "P1 is " """" P1 """"
+           DISPLAY "P2 is " """" P2 """"
+           IF P2 NOT = "OK "
+              DISPLAY P2
+              END-DISPLAY
+           END-IF.
+           MOVE SPACE TO P1.
+           EXIT PROGRAM.
+       END PROGRAM callee.
+       END PROGRAM caller.
+
diff --git a/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__2_.out b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__2_.out

new file mode 100644 (file)

index 0000000..e2bc284
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__2_.out
@@ -0,0 +1,4 @@
+P1 is "OK"
+P2 is "OK "
+On return, P1 is "  "
+
diff --git a/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__3_.cob b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__3_.cob

new file mode 100644 (file)

index 0000000..6603559
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__3_.cob
@@ -0,0 +1,25 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/ANY_LENGTH__3_.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01 str PIC X(20) VALUE ALL "X".
+       PROCEDURE DIVISION.
+           CALL "subprog" USING str.
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. subprog.
+       DATA DIVISION.
+       LINKAGE SECTION.
+       01 str PIC X ANY LENGTH.
+       PROCEDURE DIVISION USING str.
+           MOVE "abcd" TO str
+           DISPLAY FUNCTION TRIM (str)
+           MOVE "abcd" TO str (5:)
+           DISPLAY FUNCTION TRIM (str)
+           MOVE ALL "a" TO str
+           DISPLAY FUNCTION TRIM (str).
+       END PROGRAM subprog.
+       END PROGRAM prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__3_.out b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__3_.out

new file mode 100644 (file)

index 0000000..7e58e05
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__3_.out
@@ -0,0 +1,4 @@
+abcd
+abcdabcd
+aaaaaaaaaaaaaaaaaaaa
+
diff --git a/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__4_.cob b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__4_.cob

new file mode 100644 (file)

index 0000000..b4dcddc
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__4_.cob
@@ -0,0 +1,33 @@
+       *> { dg-do run }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01 str PIC X(20) VALUE ALL "X".
+
+       PROCEDURE DIVISION.
+           CALL "subprog" USING str
+           move '   45'   to str
+           CALL "subprog" USING str
+           .
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. subprog.
+
+       DATA DIVISION.
+       LINKAGE SECTION.
+       01 str PIC X ANY LENGTH.
+
+       PROCEDURE DIVISION USING str.
+           IF str = 'X'
+             DISPLAY 'X is X'
+           END-IF
+           IF str = space
+             DISPLAY 'X is space'
+           END-IF
+           .
+       END PROGRAM subprog.
+       END PROGRAM prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__5_.cob b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__5_.cob

new file mode 100644 (file)

index 0000000..fb8dfa9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__5_.cob
@@ -0,0 +1,19 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/ANY_LENGTH__5_.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       PROCEDURE DIVISION.
+       CALL "subprog"
+       GOBACK.
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. subprog.
+       DATA DIVISION.
+       LINKAGE SECTION.
+       01 str1 PIC X ANY LENGTH.
+       01 str2 PIC X ANY LENGTH.
+       PROCEDURE DIVISION USING optional str1 optional str2.
+       DISPLAY 'IN' WITH NO ADVANCING.
+       END PROGRAM subprog.
+       END PROGRAM prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__5_.out b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__5_.out

new file mode 100644 (file)

index 0000000..2c9e08f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/ANY_LENGTH__5_.out
@@ -0,0 +1 @@
+IN
diff --git a/gcc/testsuite/cobol.dg/group2/Alphanumeric_MOVE_with_truncation.cob b/gcc/testsuite/cobol.dg/group2/Alphanumeric_MOVE_with_truncation.cob

new file mode 100644 (file)

index 0000000..76b1fb4
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Alphanumeric_MOVE_with_truncation.cob
@@ -0,0 +1,45 @@
+       *> { dg-do run }
+       *> { dg-options "-Wno-truncate" }
+       *> { dg-output-file "group2/Alphanumeric_MOVE_with_truncation.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  x-left  PIC X(03).
+       01  x-right PIC X(03) JUSTIFIED RIGHT.
+       PROCEDURE DIVISION.
+           MOVE '1234' TO x-left, x-right
+           DISPLAY """" x-left """" space """" x-right """"
+           IF x-left  not = '123'
+           OR x-right not = '234'
+              DISPLAY 'error with "1234":'
+              END-DISPLAY
+              DISPLAY x-left
+              END-DISPLAY
+              DISPLAY x-right
+              END-DISPLAY
+           END-IF
+           MOVE '   3' TO x-left, x-right
+           DISPLAY """" x-left """" space """" x-right """"
+           IF x-left  not = spaces
+           OR x-right not = '  3'
+              DISPLAY 'error with "   3":'
+              END-DISPLAY
+              DISPLAY x-left
+              END-DISPLAY
+              DISPLAY x-right
+              END-DISPLAY
+           END-IF
+           MOVE '3   ' TO x-left, x-right
+           DISPLAY """" x-left """" space """" x-right """"
+           IF x-left  not = '3'
+           OR x-right not = spaces
+              DISPLAY 'error with "3   ":'
+              END-DISPLAY
+              DISPLAY x-left
+              END-DISPLAY
+              DISPLAY x-right
+              END-DISPLAY
+           END-IF.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Alphanumeric_MOVE_with_truncation.out b/gcc/testsuite/cobol.dg/group2/Alphanumeric_MOVE_with_truncation.out

new file mode 100644 (file)

index 0000000..1bddffb
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Alphanumeric_MOVE_with_truncation.out
@@ -0,0 +1,4 @@
+"123" "234"
+"   " "  3"
+"3  " "   "
+
diff --git a/gcc/testsuite/cobol.dg/group2/Alphanumeric_and_binary_numeric.cob b/gcc/testsuite/cobol.dg/group2/Alphanumeric_and_binary_numeric.cob

new file mode 100644 (file)

index 0000000..8ce12ee
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Alphanumeric_and_binary_numeric.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X-X           PIC XXXX VALUE "0001".
+       01 X-9           PIC 9999 COMP VALUE 1.
+       PROCEDURE        DIVISION.
+         IF X-X = X-9
+            STOP RUN
+         END-IF.
+         DISPLAY "NG" NO ADVANCING
+         END-DISPLAY
+         STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/CALL_with_OMITTED_parameter.cob b/gcc/testsuite/cobol.dg/group2/CALL_with_OMITTED_parameter.cob

new file mode 100644 (file)

index 0000000..0c5647c
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/CALL_with_OMITTED_parameter.cob
@@ -0,0 +1,38 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/CALL_with_OMITTED_parameter.out" }
+
+        IDENTIFICATION   DIVISION.
+        PROGRAM-ID.      caller.
+        DATA             DIVISION.
+        WORKING-STORAGE  SECTION.
+        01 P1            PIC X    VALUE "A".
+        01 P2            PIC X    VALUE "B".
+        PROCEDURE        DIVISION.
+            DISPLAY "Should see AB"
+            CALL "callee" USING P1 P2
+            DISPLAY "Should see A"
+            CALL "callee" USING P1
+            END-CALL.
+            DISPLAY "Should see A"
+            CALL "callee" USING P1 OMITTED
+            END-CALL.
+            STOP RUN.
+        END PROGRAM caller.
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      callee.
+       DATA             DIVISION.
+       LINKAGE          SECTION.
+       01 P1            PIC X.
+       01 P2            PIC X.
+       PROCEDURE        DIVISION USING P1 OPTIONAL P2.
+           DISPLAY """" P1 WITH NO ADVANCING
+           IF P2 NOT OMITTED
+              DISPLAY P2 """"
+              END-DISPLAY
+           ELSE
+              DISPLAY """"
+              END-DISPLAY
+           END-IF.
+           EXIT PROGRAM.
+        END PROGRAM callee.
+
diff --git a/gcc/testsuite/cobol.dg/group2/CALL_with_OMITTED_parameter.out b/gcc/testsuite/cobol.dg/group2/CALL_with_OMITTED_parameter.out

new file mode 100644 (file)

index 0000000..1a77e2c
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/CALL_with_OMITTED_parameter.out
@@ -0,0 +1,7 @@
+Should see AB
+"AB"
+Should see A
+"A"
+Should see A
+"A"
+
diff --git a/gcc/testsuite/cobol.dg/group2/CONTINUE_AFTER_1_SECONDS.cob b/gcc/testsuite/cobol.dg/group2/CONTINUE_AFTER_1_SECONDS.cob

new file mode 100644 (file)

index 0000000..0c4e115
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/CONTINUE_AFTER_1_SECONDS.cob
@@ -0,0 +1,28 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/CONTINUE_AFTER_1_SECONDS.out" }
+
+        program-id. prog.
+        data division.
+        working-storage section.
+        01 tod pic x(64).
+        01 tstart pic 9999.
+        01 tend   pic 9999.
+        01 tspan  pic 9999.
+        procedure division.
+        accept tod from time
+        move tod(5:) to tstart
+        continue after 1.0 seconds.
+        accept tod from time
+        move tod(5:) to tend
+        if tend < tstart 
+            compute tend = tend + 6000
+        end-if
+        compute tspan = tend - tstart
+        if tspan >= 75 and tspan <= 125
+            display "Looks good"
+        else
+            display "Looks bad! " tstart space tend space tspan
+        end-if
+        goback.
+        end program prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/CONTINUE_AFTER_1_SECONDS.out b/gcc/testsuite/cobol.dg/group2/CONTINUE_AFTER_1_SECONDS.out

new file mode 100644 (file)

index 0000000..74b5c81
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/CONTINUE_AFTER_1_SECONDS.out
@@ -0,0 +1,2 @@
+Looks good
+
diff --git a/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN.cob b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN.cob

new file mode 100644 (file)

index 0000000..f1ebd6a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN.cob
@@ -0,0 +1,22 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/CURRENCY_SIGN.out" }
+
+       PROGRAM-ID.   prog.
+
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+       SPECIAL-NAMES.
+           CURRENCY SIGN IS "Y".
+
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       77  amount    pic Y(6)9.99.
+
+       PROCEDURE DIVISION.
+           Move 1512.34 to Amount
+           Display "Amount is #" Amount '#' with no advancing.
+
+           GOBACK
+           .
+       END PROGRAM prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN.out b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN.out

new file mode 100644 (file)

index 0000000..d49ed31
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN.out
@@ -0,0 +1 @@
+Amount is #  Y1512.34#
diff --git a/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob

new file mode 100644 (file)

index 0000000..eff0822
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob
@@ -0,0 +1,32 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.out" }
+
+       PROGRAM-ID.   prog.
+
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+       SPECIAL-NAMES.
+           *> note the space after EUR / before ct.
+           CURRENCY SIGN IS "EUR "      WITH PICTURE SYMBOL "U",
+           CURRENCY SIGN IS " ct (EUR)" WITH PICTURE SYMBOL "c",
+           Currency Sign is "$US" with Picture Symbol "$".
+
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       77  EUROS    PIC U99v99.
+       77  cents    PIC 9,999c.
+       77  DOLLARS  Pic $$,$$9.99.
+
+       PROCEDURE DIVISION.
+           MOVE 12.34 TO EUROS
+           MULTIPLY euros BY 100 GIVING cents.
+           DISPLAY "#" EUROS "# equal #" cents '#'.
+           Move 1500 to DOLLARS
+           Display "Invoice amount #1 is " DOLLARS '.'.
+           Move 12.34 to DOLLARS
+           Display "Invoice amount #2 is " DOLLARS '.'.
+
+           GOBACK
+           .
+       END PROGRAM prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.out b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.out

new file mode 100644 (file)

index 0000000..861e65a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.out
@@ -0,0 +1,4 @@
+#EUR 12.34# equal #1,234 ct (EUR)#
+Invoice amount #1 is $US1,500.00.
+Invoice amount #2 is    $US12.34.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Class_check_with_reference_modification.cob b/gcc/testsuite/cobol.dg/group2/Class_check_with_reference_modification.cob

new file mode 100644 (file)

index 0000000..62d6bc8
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Class_check_with_reference_modification.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC X(6) VALUE "123   ".
+       PROCEDURE        DIVISION.
+           IF X(1:3) NUMERIC
+              STOP RUN
+           END-IF.
+           DISPLAY "NG" NO ADVANCING
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE.cob b/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE.cob

new file mode 100644 (file)

index 0000000..797c6fe
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE.cob
@@ -0,0 +1,76 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Complex_HEX__VALUE_and_MOVE.out" }
+
+        identification division.
+        program-id. hex-init.
+        data division.
+        working-storage section.
+        01  var-01020304.
+            05 filler1.
+                10 filler2      pic x(2) VALUE "33".
+                10 as-value     pic x(4) VALUE  X'01020304'.
+                10 filler3      pic x(2) VALUE "33".
+            05 as-pointer redefines filler1 usage pointer.
+
+        01  var-low.
+            05 filler1.
+                10 filler2      pic x(2) VALUE "33".
+                10 as-value     pic x(4) VALUE  LOW-VALUES.
+                10 filler3      pic x(2) VALUE "33".
+            05 as-pointer redefines filler1 usage pointer.
+        01  var-space.
+            05 filler1.
+                10 filler2      pic x(2) VALUE "33".
+                10 as-value     pic x(4) VALUE  SPACE.
+                10 filler3      pic x(2) VALUE "33".
+            05 as-pointer redefines filler1 usage pointer.
+        01  var-quote.
+            05 filler1.
+                10 filler2      pic x(2) VALUE "33".
+                10 as-value     pic x(4) VALUE  QUOTE.
+                10 filler3      pic x(2) VALUE "33".
+            05 as-pointer redefines filler1 usage pointer.
+        01  var-zero.
+            05 filler1.
+                10 filler2      pic x(2) VALUE "33".
+                10 as-value     pic x(4) VALUE  ZERO.
+                10 filler3      pic x(2) VALUE "33".
+            05 as-pointer redefines filler1 usage pointer.
+        01  var-high.
+            05 filler1.
+                10 filler2      pic x(2) VALUE "33".
+                10 as-value     pic x(4) VALUE  HIGH-VALUES.
+                10 filler3      pic x(2) VALUE "33".
+            05 as-pointer redefines filler1 usage pointer.
+        01  move-target.
+            05 filler1.
+                10 filler2      pic x(2) VALUE "33".
+                10 as-value     pic x(4) VALUE "3333".
+                10 filler3      pic x(2) VALUE "33".
+            05 as-pointer redefines filler1 usage pointer.
+        procedure division.
+        display "the value is    " as-pointer of var-01020304.
+        display "should be       0x3333040302013333"
+        display "var-low  :      " as-pointer of var-low
+        display "var-space:      " as-pointer of var-space
+        display "var-quote:      " as-pointer of var-quote
+        display "var-zero :      " as-pointer of var-zero
+        display "var-high :      " as-pointer of var-high
+        display "initial         " as-pointer of move-target
+        move low-value to as-value of move-target
+        display "low-value       " as-pointer of move-target
+        move space to as-value of move-target
+        display "space           " as-pointer of move-target
+        move quote to as-value of move-target
+        display "quote           " as-pointer of move-target
+        move zeroes to as-value of move-target
+        display "zeroes          " as-pointer of move-target
+        move high-value to as-value of move-target
+        display "high-value      " as-pointer of move-target
+        move X'01020304' to as-value of move-target
+        display "01020304        " as-pointer of move-target
+        move "33333333" to move-target
+        move X'00' to filler3 of move-target(1:1)
+        display "ref-mod         " as-pointer of move-target
+        stop run.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE.out b/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE.out

new file mode 100644 (file)

index 0000000..366d0c2
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE.out
@@ -0,0 +1,16 @@
+the value is    0x3333040302013333
+should be       0x3333040302013333
+var-low  :      0x3333000000003333
+var-space:      0x3333202020203333
+var-quote:      0x3333222222223333
+var-zero :      0x3333303030303333
+var-high :      0x3333ffffffff3333
+initial         0x3333333333333333
+low-value       0x3333000000003333
+space           0x3333202020203333
+quote           0x3333222222223333
+zeroes          0x3333303030303333
+high-value      0x3333ffffffff3333
+01020304        0x3333040302013333
+ref-mod         0x3300333333333333
+
diff --git a/gcc/testsuite/cobol.dg/group2/Complex_IF.cob b/gcc/testsuite/cobol.dg/group2/Complex_IF.cob

new file mode 100644 (file)

index 0000000..aa3ebde
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Complex_IF.cob
@@ -0,0 +1,23 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Complex_IF.out" }
+        identification division.
+        program-id. phonebook.
+        data division.
+        working-storage section.
+        01 name1 pic x(10) value "one".
+        01 name2 pic x(10) value "two".
+        01 flag  pic x     value 'a'.
+        procedure division.
+        move 'l' to flag
+        perform checkit
+        goback.
+        checkit.
+            if (name1 = name2 and flag = "F" or "f" )
+                or flag = "L" or "l"
+            then
+               display "the test is TRUE"
+            else
+               display "the test is FALSE"
+            end-if.
+        end program phonebook.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Complex_IF.out b/gcc/testsuite/cobol.dg/group2/Complex_IF.out

new file mode 100644 (file)

index 0000000..ce94a61
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Complex_IF.out
@@ -0,0 +1,2 @@
+the test is TRUE
+
diff --git a/gcc/testsuite/cobol.dg/group2/Concatenation_operator.cob b/gcc/testsuite/cobol.dg/group2/Concatenation_operator.cob

new file mode 100644 (file)

index 0000000..fef757b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Concatenation_operator.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Concatenation_operator.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       77 STR           PIC X(05).
+       PROCEDURE        DIVISION.
+           MOVE "OK" & " "
+            & "OK"
+             TO STR
+           DISPLAY STR NO ADVANCING
+           END-DISPLAY
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Concatenation_operator.out b/gcc/testsuite/cobol.dg/group2/Concatenation_operator.out

new file mode 100644 (file)

index 0000000..618798a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Concatenation_operator.out
@@ -0,0 +1 @@
+OK OK
diff --git a/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__1_.cob b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__1_.cob

new file mode 100644 (file)

index 0000000..2362d15
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__1_.cob
@@ -0,0 +1,18 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/DECIMAL-POINT_is_COMMA__1_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       ENVIRONMENT      DIVISION.
+       CONFIGURATION    SECTION.
+       SPECIAL-NAMES.
+           DECIMAL-POINT    IS COMMA.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  X            PIC 99V99.
+       PROCEDURE        DIVISION.
+           MOVE FUNCTION MIN (3,,,,,,5) TO X.
+           DISPLAY X
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__1_.out b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__1_.out

new file mode 100644 (file)

index 0000000..0b9310e
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__1_.out
@@ -0,0 +1,2 @@
+00,50
+
diff --git a/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__2_.cob b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__2_.cob

new file mode 100644 (file)

index 0000000..b69ee3b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__2_.cob
@@ -0,0 +1,18 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/DECIMAL-POINT_is_COMMA__2_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       ENVIRONMENT      DIVISION.
+       CONFIGURATION    SECTION.
+       SPECIAL-NAMES.
+           DECIMAL-POINT    IS COMMA.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  X            PIC 99V99.
+       PROCEDURE        DIVISION.
+           MOVE FUNCTION MIN (3,,,,,, 5) TO X.
+           DISPLAY X
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__2_.out b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__2_.out

new file mode 100644 (file)

index 0000000..9dcfab9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__2_.out
@@ -0,0 +1,2 @@
+03,00
+
diff --git a/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__3_.cob b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__3_.cob

new file mode 100644 (file)

index 0000000..114b9ea
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__3_.cob
@@ -0,0 +1,18 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/DECIMAL-POINT_is_COMMA__3_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       ENVIRONMENT      DIVISION.
+       CONFIGURATION    SECTION.
+       SPECIAL-NAMES.
+           DECIMAL-POINT    IS COMMA.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  X            PIC 99V99.
+       PROCEDURE        DIVISION.
+           MOVE FUNCTION MIN (3,,,,,, 1,5) TO X.
+           DISPLAY X
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__3_.out b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__3_.out

new file mode 100644 (file)

index 0000000..5a24d4d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__3_.out
@@ -0,0 +1,2 @@
+01,50
+
diff --git a/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__4_.cob b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__4_.cob

new file mode 100644 (file)

index 0000000..d969c73
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__4_.cob
@@ -0,0 +1,18 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/DECIMAL-POINT_is_COMMA__4_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       ENVIRONMENT      DIVISION.
+       CONFIGURATION    SECTION.
+       SPECIAL-NAMES.
+           DECIMAL-POINT    IS COMMA.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  X            PIC 99V99.
+       PROCEDURE        DIVISION.
+           MOVE FUNCTION MIN (3, 1,5) TO X.
+           DISPLAY X
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__4_.out b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__4_.out

new file mode 100644 (file)

index 0000000..5a24d4d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__4_.out
@@ -0,0 +1,2 @@
+01,50
+
diff --git a/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__5_.cob b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__5_.cob

new file mode 100644 (file)

index 0000000..2ca9881
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__5_.cob
@@ -0,0 +1,23 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/DECIMAL-POINT_is_COMMA__5_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       ENVIRONMENT      DIVISION.
+       CONFIGURATION    SECTION.
+       SPECIAL-NAMES.
+           DECIMAL-POINT    IS COMMA.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  X            PIC 99V99.
+       PROCEDURE        DIVISION.
+           COMPUTE X=1 + ,1
+           END-COMPUTE
+           DISPLAY X
+           END-DISPLAY.
+           COMPUTE X=1*,1
+           END-COMPUTE
+           DISPLAY X
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__5_.out b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__5_.out

new file mode 100644 (file)

index 0000000..809e6ae
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__5_.out
@@ -0,0 +1,3 @@
+01,10
+00,10
+
diff --git a/gcc/testsuite/cobol.dg/group2/EC-SIZE-TRUNCATION_EC-SIZE-OVERFLOW.cob b/gcc/testsuite/cobol.dg/group2/EC-SIZE-TRUNCATION_EC-SIZE-OVERFLOW.cob

new file mode 100644 (file)

index 0000000..60310f7
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EC-SIZE-TRUNCATION_EC-SIZE-OVERFLOW.cob
@@ -0,0 +1,30 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/EC-SIZE-TRUNCATION_EC-SIZE-OVERFLOW.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  x PIC 9 VALUE 1.
+       01  y PIC 9.
+       01  a     COMP-1 VALUE 1.E20.
+       01  b     COMP-1 VALUE 1.E20.
+       PROCEDURE DIVISION.
+           DIVIDE x BY 0.1 GIVING y
+           DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-STATUS)
+           IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS)
+           NOT = 'EC-SIZE-TRUNCATION'
+              DISPLAY 'Wrong/missing exception: '
+                      FUNCTION EXCEPTION-STATUS
+              END-DISPLAY
+           END-IF.
+        SET LAST EXCEPTION TO OFF
+           MULTIPLY a BY b GIVING b
+           DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-STATUS)
+           IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS)
+           NOT = 'EC-SIZE-OVERFLOW'
+              DISPLAY 'Wrong/missing exception: '
+                      FUNCTION EXCEPTION-STATUS
+              END-DISPLAY
+           END-IF.
+
diff --git a/gcc/testsuite/cobol.dg/group2/EC-SIZE-TRUNCATION_EC-SIZE-OVERFLOW.out b/gcc/testsuite/cobol.dg/group2/EC-SIZE-TRUNCATION_EC-SIZE-OVERFLOW.out

new file mode 100644 (file)

index 0000000..8c86ad2
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EC-SIZE-TRUNCATION_EC-SIZE-OVERFLOW.out
@@ -0,0 +1,3 @@
+EC-SIZE-TRUNCATION
+EC-SIZE-OVERFLOW
+
diff --git a/gcc/testsuite/cobol.dg/group2/EC-SIZE-ZERO-DIVIDE__fixed_and_float.cob b/gcc/testsuite/cobol.dg/group2/EC-SIZE-ZERO-DIVIDE__fixed_and_float.cob

new file mode 100644 (file)

index 0000000..8b5657b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EC-SIZE-ZERO-DIVIDE__fixed_and_float.cob
@@ -0,0 +1,64 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/EC-SIZE-ZERO-DIVIDE__fixed_and_float.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  x PIC 9 VALUE 0.
+       01  y PIC 9 VALUE 0.
+       01  fx comp-2 VALUE 0.
+       01  fy comp-2 VALUE 0.
+       PROCEDURE DIVISION.
+           DISPLAY "Fixed-point divide by zero:"
+           DIVIDE x BY y GIVING y
+           DISPLAY "1 - """ FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """"
+           IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS)
+           NOT = 'EC-SIZE-ZERO-DIVIDE'
+              DISPLAY '1 Wrong/missing exception: '
+                      FUNCTION EXCEPTION-STATUS
+              END-DISPLAY
+           END-IF
+           SET LAST EXCEPTION TO OFF
+           DISPLAY "2 - """ FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """"
+           IF FUNCTION EXCEPTION-STATUS NOT = SPACES
+              DISPLAY '2 Exception is not empty after reset: '
+                      FUNCTION EXCEPTION-STATUS
+              END-DISPLAY
+           END-IF
+           MOVE 0 TO y
+           COMPUTE y = x - 1 / y + 6.5
+           DISPLAY "3 - """ FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """"
+           IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS)
+           NOT = 'EC-SIZE-ZERO-DIVIDE'
+              DISPLAY '3 Wrong/missing exception: '
+                      FUNCTION EXCEPTION-STATUS
+              END-DISPLAY
+           END-IF.
+           SET LAST EXCEPTION TO OFF
+           DISPLAY "Floating-point divide by zero:"
+           DIVIDE fx BY fy GIVING fy
+           DISPLAY "4 - """ FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """"
+           IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS)
+           NOT = 'EC-SIZE-ZERO-DIVIDE'
+              DISPLAY '4 Wrong/missing exception: '
+                      FUNCTION EXCEPTION-STATUS
+              END-DISPLAY
+           END-IF
+           SET LAST EXCEPTION TO OFF
+           DISPLAY "5 - """ FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """"
+           IF FUNCTION EXCEPTION-STATUS NOT = SPACES
+              DISPLAY '5 Exception is not empty after reset: '
+                      FUNCTION EXCEPTION-STATUS
+              END-DISPLAY
+           END-IF
+           MOVE 0 TO fy
+           COMPUTE fy = fx - 1 / fy + 6.5
+           DISPLAY "6 - """ FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) """"
+           IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS)
+           NOT = 'EC-SIZE-ZERO-DIVIDE'
+              DISPLAY '6 Wrong/missing exception: '
+                      FUNCTION EXCEPTION-STATUS
+              END-DISPLAY
+           END-IF.
+
diff --git a/gcc/testsuite/cobol.dg/group2/EC-SIZE-ZERO-DIVIDE__fixed_and_float.out b/gcc/testsuite/cobol.dg/group2/EC-SIZE-ZERO-DIVIDE__fixed_and_float.out

new file mode 100644 (file)

index 0000000..93da1b8
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EC-SIZE-ZERO-DIVIDE__fixed_and_float.out
@@ -0,0 +1,9 @@
+Fixed-point divide by zero:
+1 - "EC-SIZE-ZERO-DIVIDE"
+2 - ""
+3 - "EC-SIZE-ZERO-DIVIDE"
+Floating-point divide by zero:
+4 - "EC-SIZE-ZERO-DIVIDE"
+5 - ""
+6 - "EC-SIZE-ZERO-DIVIDE"
+
diff --git a/gcc/testsuite/cobol.dg/group2/EXIT_PARAGRAPH.cob b/gcc/testsuite/cobol.dg/group2/EXIT_PARAGRAPH.cob

new file mode 100644 (file)

index 0000000..b637ecb
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EXIT_PARAGRAPH.cob
@@ -0,0 +1,21 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 INDVAL        PIC 9(4).
+       PROCEDURE        DIVISION.
+       A01.
+           PERFORM VARYING INDVAL FROM 1 BY 1 UNTIL INDVAL > 10
+            IF INDVAL > 2
+               EXIT PARAGRAPH
+            END-IF
+           END-PERFORM.
+       A02.
+           IF INDVAL NOT = 3
+              DISPLAY INDVAL NO ADVANCING
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM.cob b/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM.cob

new file mode 100644 (file)

index 0000000..d944ccd
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/EXIT_PERFORM.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       PROCEDURE        DIVISION.
+           PERFORM 2 TIMES
+             DISPLAY "OK" NO ADVANCING
+             END-DISPLAY
+             EXIT PERFORM
+             DISPLAY "NOT OK"
+             END-DISPLAY
+           END-PERFORM
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM.out b/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM.out

new file mode 100644 (file)

index 0000000..d86bac9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM.out
@@ -0,0 +1 @@
+OK
diff --git a/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM_CYCLE.cob b/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM_CYCLE.cob

new file mode 100644 (file)

index 0000000..7d67bd1
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM_CYCLE.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/EXIT_PERFORM_CYCLE.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       PROCEDURE        DIVISION.
+           PERFORM 2 TIMES
+             DISPLAY "OK" NO ADVANCING
+             END-DISPLAY
+             EXIT PERFORM CYCLE
+             DISPLAY "NOT OK"
+             END-DISPLAY
+           END-PERFORM
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM_CYCLE.out b/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM_CYCLE.out

new file mode 100644 (file)

index 0000000..d65874e
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EXIT_PERFORM_CYCLE.out
@@ -0,0 +1 @@
+OKOK
diff --git a/gcc/testsuite/cobol.dg/group2/EXIT_SECTION.cob b/gcc/testsuite/cobol.dg/group2/EXIT_SECTION.cob

new file mode 100644 (file)

index 0000000..fc670f1
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/EXIT_SECTION.cob
@@ -0,0 +1,25 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 INDVAL        PIC 9(4).
+       PROCEDURE        DIVISION.
+       A01 SECTION.
+       A011.
+           PERFORM VARYING INDVAL FROM 1 BY 1 UNTIL INDVAL > 10
+            IF INDVAL > 2
+               EXIT SECTION
+            END-IF
+           END-PERFORM.
+       A012.
+           DISPLAY INDVAL NO ADVANCING
+           END-DISPLAY.
+       A02 SECTION.
+           IF INDVAL NOT = 3
+              DISPLAY INDVAL NO ADVANCING
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FLOAT-LONG_with_SIZE_ERROR.cob b/gcc/testsuite/cobol.dg/group2/FLOAT-LONG_with_SIZE_ERROR.cob

new file mode 100644 (file)

index 0000000..d8c81a3
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FLOAT-LONG_with_SIZE_ERROR.cob
@@ -0,0 +1,43 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FLOAT-LONG_with_SIZE_ERROR.out" }
+
+       identification division.
+       program-id. prog.
+       data division.
+       working-storage section.
+      *------------------------
+       77 counter             pic s9(4) binary value zero.
+      * FLOAT-LONG
+       77 doubleValue         COMP-2 value 2.
+       77 lastDoubleValue     COMP-2.
+      ******************************************************************
+       procedure division.
+       main section.
+           perform varying counter from 1 by 1 until
+                           counter > 1060
+      *>      display 'counter: ' counter ', value: ' doubleValue
+              compute doubleValue = doubleValue * 2
+                   ON SIZE ERROR
+                      display 'SIZE ERROR raised'
+                      end-display
+                      display 'SIZE ERROR, last value = ' doubleValue
+                      end-display
+                      exit perform
+               not ON SIZE ERROR
+                      if doubleValue > lastdoubleValue
+                         move doubleValue to lastdoubleValue
+                      else
+                         display 'math ERROR, last value > current: '
+                                 lastdoubleValue ' > ' doubleValue
+                         end-display
+                         exit perform
+                      end-if
+              end-compute
+           end-perform
+           display "counter is " counter
+           if not (counter >= 1023 and <=1025)
+              display ' '
+              display 'counter is ' counter
+           end-if
+           goback.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FLOAT-LONG_with_SIZE_ERROR.out b/gcc/testsuite/cobol.dg/group2/FLOAT-LONG_with_SIZE_ERROR.out

new file mode 100644 (file)

index 0000000..208bd8a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FLOAT-LONG_with_SIZE_ERROR.out
@@ -0,0 +1,4 @@
+SIZE ERROR raised
+SIZE ERROR, last value = 8.98846567431157954E+307
+counter is +1023
+
diff --git a/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT___FLOAT-LONG_w_o_SIZE_ERROR.cob b/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT___FLOAT-LONG_w_o_SIZE_ERROR.cob

new file mode 100644 (file)

index 0000000..e00676c
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT___FLOAT-LONG_w_o_SIZE_ERROR.cob
@@ -0,0 +1,164 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FLOAT-SHORT___FLOAT-LONG_w_o_SIZE_ERROR.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  CMP1                        COMP-1.
+       01  SV1                         COMP-1.
+       01  CMP2                        COMP-2.
+       01  SV2                         COMP-2.
+
+       PROCEDURE DIVISION.
+       CND-000.
+
+           DISPLAY "--- COMP-1 ---"
+           COMPUTE CMP1 = (((1.0E7 / 2.1E0) / 3.1E0) - 5.0E-1) * 6.0E0
+           DISPLAY "A: " CMP1
+           COMPUTE CMP1 = (((1.0E7 / 2.9E0) / 3.9E0) - 5.0E-1) * 6.0E0
+           DISPLAY "B: " CMP1
+           MOVE ZERO TO CMP1.
+           COMPUTE CMP1 = 1.0E3 / 2.1E0
+                   ON SIZE ERROR DISPLAY "Z: " CMP1 " SIZE ERROR"
+               NOT ON SIZE ERROR DISPLAY "Z: " CMP1 " IS OK"
+           END-COMPUTE.
+
+           DISPLAY "    ..."
+           DISPLAY "--- COMP-2 ---"
+           COMPUTE CMP2 = (((1.0E7 / 2.1E0) / 3.1E0) - 5.0E-1) * 6.0E0
+      *>   because of possible rounding of intermediates and different
+      *>   precision depending on math library / version: plain DISPLAY
+           IF CMP2 >= 9216586.86175114 AND <= 9216586.86175116
+             DISPLAY "A ~ 9216586.86175115"
+           ELSE
+             DISPLAY "A: " CMP2
+           END-IF
+           COMPUTE CMP2 = (((1.0E7 / 2.9E0) / 3.9E0) - 5.0E-1) * 6.0E0
+           IF CMP2 >= 5305036.7877983 AND <= 5305036.7877985
+             DISPLAY "B ~ 5305036.787798408"
+           ELSE
+             DISPLAY "B: " CMP2
+           END-IF
+           MOVE ZERO TO CMP2.
+           COMPUTE CMP2 = 1.0E3 / 2.1E0
+                   ON SIZE ERROR DISPLAY "Z: " CMP2 " SIZE ERROR"
+               NOT ON SIZE ERROR
+      *>        see note above
+                IF CMP2 >= 476.1904761904760 AND <= 476.1904761904763
+                  DISPLAY "Z ~ 476.1904761904761 IS OK"
+                ELSE
+                  DISPLAY "Z: " CMP2 " IS OK"
+                END-IF
+           END-COMPUTE.
+
+           DISPLAY "    ..."
+           DISPLAY "--- 99 + 1 / 3 ---"
+           MOVE -1 TO CMP1, CMP2.
+           COMPUTE CMP1 = 99 + 1 / 3
+                   ON SIZE ERROR DISPLAY "CMP1: " CMP1 " SIZE ERROR"
+               NOT ON SIZE ERROR DISPLAY "CMP1: " CMP1 " IS OK"
+           END-COMPUTE.
+           COMPUTE CMP2 = 99 + 1 / 3
+                   ON SIZE ERROR DISPLAY "CMP2: " CMP2 " SIZE ERROR"
+               NOT ON SIZE ERROR DISPLAY "CMP2: " CMP2 " IS OK"
+           END-COMPUTE.
+
+           DISPLAY "    ..."
+           DISPLAY "--- 99 ---"
+           MOVE -1 TO CMP1, CMP2.
+           COMPUTE CMP1 = 99
+                   ON SIZE ERROR DISPLAY "CMP1: " CMP1 " SIZE ERROR"
+               NOT ON SIZE ERROR DISPLAY "CMP1: " CMP1 " IS OK"
+           END-COMPUTE.
+           COMPUTE CMP2 = 99
+                   ON SIZE ERROR DISPLAY "CMP2: " CMP2 " SIZE ERROR"
+               NOT ON SIZE ERROR DISPLAY "CMP2: " CMP2 " IS OK"
+           END-COMPUTE.
+
+       CND-100-OK.
+           DISPLAY "    ..."
+           DISPLAY "--- Test overflow ---"
+
+           MOVE 990000 TO CMP1.
+           PERFORM 6500 TIMES
+             MOVE CMP1 TO SV1
+             COMPUTE CMP1 = CMP1 * 10
+                    ON SIZE ERROR GO TO CND-350-ERR
+             END-COMPUTE
+             IF CMP1 < 9.0
+               GO TO CND-350-ERR
+             END-IF
+           END-PERFORM.
+           DISPLAY "CMP1: " CMP1 " IS OK".
+           GO TO CND-350-OK.
+       CND-350-ERR.
+           DISPLAY "CMP1: after " SV1 " SIZE ERROR".
+
+       CND-350-OK.
+           MOVE 9900000000 TO CMP2.
+           PERFORM 6500 TIMES
+             MOVE CMP2 TO SV2
+             COMPUTE CMP2 = CMP2 * 10
+                    ON SIZE ERROR GO TO CND-380-ERR
+             END-COMPUTE
+             IF CMP2 < 9.0
+               GO TO CND-380-ERR
+             END-IF
+           END-PERFORM.
+           DISPLAY "CMP2: " CMP2 " IS OK".
+           GO TO CND-500-OK.
+       CND-380-ERR.
+      *>   because of possible rounding of intermediates and different
+      *>   precision depending on math library / version: plain DISPLAY
+           IF SV2 >= 9.899999999999E+307 AND
+                  <= 9.900000000001E+307
+             DISPLAY "CMP2: after ~ 9.899999999999781E+307 SIZE ERROR"
+           ELSE
+             DISPLAY "CMP2: after " SV2 " SIZE ERROR"
+           END-IF
+           .
+
+       CND-500-OK.
+           MOVE 0.000000099 TO CMP1.
+           PERFORM 350 TIMES
+             MOVE CMP1 TO SV1
+             COMPUTE CMP1 = CMP1 / 10.0
+                    ON SIZE ERROR GO TO CND-500-ERR
+             END-COMPUTE
+             IF CMP1 = 0.0
+               GO TO CND-500-ERR
+             END-IF
+           END-PERFORM.
+           DISPLAY "CMP1: " CMP1 " IS OK".
+           GO TO CND-600-OK.
+       CND-500-ERR.
+           DISPLAY "CMP1: after " SV1 " SIZE ERROR".
+
+       CND-600-OK.
+           MOVE 0.000000099 TO CMP2.
+           PERFORM 350 TIMES
+             MOVE CMP2 TO SV2
+             COMPUTE CMP2 = CMP2 / 10.0
+                    ON SIZE ERROR GO TO CND-600-ERR
+             END-COMPUTE
+             IF CMP2 = 0.0
+               GO TO CND-600-ERR
+             END-IF
+           END-PERFORM.
+           DISPLAY "CMP2: " CMP2 " IS OK".
+           GO TO CND-600-XIT.
+       CND-600-ERR.
+           IF SV2 >= 9.8813129168249E-324 AND <= 9.881312916825E-324
+             DISPLAY "CMP2: after ~ 9.881312916824931E-324 SIZE ERROR"
+           ELSE
+             DISPLAY "CMP2: after " SV2 " SIZE ERROR"
+           END-IF
+           .
+       CND-600-XIT.
+
+       CND-999.
+           STOP RUN.
+       END PROGRAM prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT___FLOAT-LONG_w_o_SIZE_ERROR.out b/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT___FLOAT-LONG_w_o_SIZE_ERROR.out

new file mode 100644 (file)

index 0000000..18fc770
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT___FLOAT-LONG_w_o_SIZE_ERROR.out
@@ -0,0 +1,24 @@
+--- COMP-1 ---
+A: 9.216587E+06
+B: 5.305037E+06
+Z: 476.1904907 IS OK
+    ...
+--- COMP-2 ---
+A ~ 9216586.86175115
+B ~ 5305036.787798408
+Z ~ 476.1904761904761 IS OK
+    ...
+--- 99 + 1 / 3 ---
+CMP1: 99.33333588 IS OK
+CMP2: 99.3333333333333286 IS OK
+    ...
+--- 99 ---
+CMP1: 99 IS OK
+CMP2: 99 IS OK
+    ...
+--- Test overflow ---
+CMP1: after 9.899998274E+37 SIZE ERROR
+CMP2: after ~ 9.899999999999781E+307 SIZE ERROR
+CMP1: after 1.401298464E-45 SIZE ERROR
+CMP2: after ~ 9.881312916824931E-324 SIZE ERROR
+
diff --git a/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT_with_SIZE_ERROR.cob b/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT_with_SIZE_ERROR.cob

new file mode 100644 (file)

index 0000000..b194442
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT_with_SIZE_ERROR.cob
@@ -0,0 +1,40 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FLOAT-SHORT_with_SIZE_ERROR.out" }
+
+       identification division.
+       program-id. prog.
+
+       data division.
+       working-storage section.
+      *------------------------
+       77 counter             pic s9(4) binary value zero.
+      * FLOAT-SHORT (if binary-comp-1 is not active)
+       77 floatValue          COMP-1  value 2.
+       77 lastFloatValue      COMP-1.
+
+      ******************************************************************
+       procedure division.
+       main section.
+           perform varying counter from 1 by 1 until
+                           counter > 130
+      *>      display 'counter: ' counter ', value: ' floatValue
+              compute floatValue = floatValue * 2
+                   ON SIZE ERROR
+                      display 'SIZE ERROR, last value = ' floatValue
+                      exit perform
+               not ON SIZE ERROR
+                      if floatValue > lastFloatValue
+                         move floatValue to lastFloatValue
+                      else
+                         display 'math ERROR, last value > current: '
+                                 lastFloatValue ' > ' floatValue
+                         exit perform
+                      end-if
+              end-compute
+           end-perform
+           if counter not = 127
+              display 'counter is ' counter
+           end-if
+
+           goback.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT_with_SIZE_ERROR.out b/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT_with_SIZE_ERROR.out

new file mode 100644 (file)

index 0000000..e5ba05f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FLOAT-SHORT_with_SIZE_ERROR.out
@@ -0,0 +1,2 @@
+SIZE ERROR, last value = 1.701411835E+38
+
diff --git a/gcc/testsuite/cobol.dg/group2/Fixed_continuation_indicator.cob b/gcc/testsuite/cobol.dg/group2/Fixed_continuation_indicator.cob

new file mode 100644 (file)

index 0000000..2c23e7b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Fixed_continuation_indicator.cob
@@ -0,0 +1,33 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Fixed_continuation_indicator.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC X(333) VALUE
+           '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWX
+      -    'YZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUV
+      -    'WXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRST
+      -    'UVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQR
+      -    'STUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOP
+      -             'QRSTUVWXYZ'.
+       PROCEDURE        DIVISION.
+           DISPLAY X NO ADVANCING
+           END-DISPLAY.
+           DISPLAY '_'
+           END-DISPLAY.
+           MOVE
+           "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ01234567
+      -    "89abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345
+      -    "6789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123
+      -    "456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ01
+      -     "23456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXY
+      -                                                               "Z
+      -             "0123456789" TO X.
+           DISPLAY X NO ADVANCING
+           END-DISPLAY.
+           DISPLAY '_'
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Fixed_continuation_indicator.out b/gcc/testsuite/cobol.dg/group2/Fixed_continuation_indicator.out

new file mode 100644 (file)

index 0000000..2a472b8
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Fixed_continuation_indicator.out
@@ -0,0 +1,3 @@
+0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ                       _
+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789                       _
+
diff --git a/gcc/testsuite/cobol.dg/group2/Index_and_parenthesized_expression.cob b/gcc/testsuite/cobol.dg/group2/Index_and_parenthesized_expression.cob

new file mode 100644 (file)

index 0000000..88c24fd
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Index_and_parenthesized_expression.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Index_and_parenthesized_expression.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 G.
+         02 X           PIC X OCCURS 1 INDEXED BY I.
+       PROCEDURE        DIVISION.
+         IF I < (I + 2)
+           DISPLAY "OK" NO ADVANCING
+           END-DISPLAY
+         END-IF.
+         STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Index_and_parenthesized_expression.out b/gcc/testsuite/cobol.dg/group2/Index_and_parenthesized_expression.out

new file mode 100644 (file)

index 0000000..d86bac9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Index_and_parenthesized_expression.out
@@ -0,0 +1 @@
+OK
diff --git a/gcc/testsuite/cobol.dg/group2/LENGTH_OF_omnibus.cob b/gcc/testsuite/cobol.dg/group2/LENGTH_OF_omnibus.cob

new file mode 100644 (file)

index 0000000..7b24aed
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/LENGTH_OF_omnibus.cob
@@ -0,0 +1,107 @@
+       *> { dg-do run }
+       *> { dg-options "-dialect ibm" }
+       *> { dg-output-file "group2/LENGTH_OF_omnibus.out" }
+
+        program-id. prog.
+        data division.
+        working-storage section.
+        01      desc1.
+         05     desc1-entry pic x(5) occurs 10.
+
+        01      desc2.
+         05     desc2-table occurs 10 times.
+          10    desc2-entry pic x(5).
+
+        01      desc3.
+         05     desc3-outer occurs 1 to 5 times depending on desc3-lim.
+          10    desc3-outer-txt   pic x(7).
+          10    desc3-inner occurs 11 times.
+           15   desc3-inner-text  pic x(13).
+        77 desc3-lim binary-long.
+
+        77      msg pic x(64).
+        77      should-be pic zzzz9.
+        77      but-is    pic zzzz9.
+
+        procedure division.
+
+        display "using LENGTH OF"
+
+        move    "Length of desc1" to msg
+        move    50 to should-be
+        move    length of desc1 to but-is
+        perform result-is
+
+        move    "Length of desc1-entry" to msg
+        move    5 to should-be
+        move    length of desc1-entry to but-is
+        perform result-is
+
+        move    "Length of desc1-entry(1)" to msg
+        move    5 to should-be
+        move    length of desc1-entry(1) to but-is
+        perform result-is
+
+        move    "Length of desc2" to msg
+        move    50 to should-be
+        move    length of desc2 to but-is
+        perform result-is
+
+        move    "Length of desc2-table" to msg
+        move    5 to should-be
+        move    length of desc2-table to but-is
+        perform result-is
+
+        move    "Length of desc2-entry" to msg
+        move    5 to should-be
+        move    length of desc2-entry to but-is
+        perform result-is
+
+        move    "Length of desc2-entry(1)" to msg
+        move    5 to should-be
+        move    length of desc2-entry(1) to but-is
+        perform result-is
+
+        move    5 to desc3-lim
+
+        move    "Length of desc3" to msg
+        move    750 to should-be
+        move    length of desc3 to but-is
+        perform result-is
+
+        move    "Length of desc3-outer" to msg
+        move    150 to should-be
+        move    length of desc3-outer to but-is
+        perform result-is
+
+        move    "Length of desc3-outer(1)" to msg
+        move    150 to should-be
+        move    length of desc3-outer(1) to but-is
+        perform result-is
+
+        move    "Length of desc3-outer-txt" to msg
+        move    7 to should-be
+        move    length of desc3-outer-txt to but-is
+        perform result-is
+
+        move    "Length of desc3-inner" to msg
+        move    13 to should-be
+        move    length of desc3-inner to but-is
+        perform result-is
+
+        move    "Length of desc3-inner(1)" to msg
+        move    13 to should-be
+        move    length of desc3-inner(1) to but-is
+        perform result-is
+
+        goback.
+        result-is.
+        display function trim(msg) ": " with no advancing
+        if but-is equal to should-be
+            display function trim(but-is)
+        else
+            display "should be " function trim(should-be)
+                    " but is "   function trim(but-is)
+        end-if.
+        end program prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/LENGTH_OF_omnibus.out b/gcc/testsuite/cobol.dg/group2/LENGTH_OF_omnibus.out

new file mode 100644 (file)

index 0000000..e4cf801
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/LENGTH_OF_omnibus.out
@@ -0,0 +1,15 @@
+using LENGTH OF
+Length of desc1: 50
+Length of desc1-entry: 5
+Length of desc1-entry(1): 5
+Length of desc2: 50
+Length of desc2-table: 5
+Length of desc2-entry: 5
+Length of desc2-entry(1): 5
+Length of desc3: 750
+Length of desc3-outer: 150
+Length of desc3-outer(1): 150
+Length of desc3-outer-txt: 7
+Length of desc3-inner: 13
+Length of desc3-inner(1): 13
+
diff --git a/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__3__with_recursive_PROGRAM-ID.cob b/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__3__with_recursive_PROGRAM-ID.cob

new file mode 100644 (file)

index 0000000..a4410fa
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__3__with_recursive_PROGRAM-ID.cob
@@ -0,0 +1,28 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/LOCAL-STORAGE__3__with_recursive_PROGRAM-ID.out" }
+
+        IDENTIFICATION   DIVISION.
+        PROGRAM-ID.      caller.
+        PROCEDURE        DIVISION.
+           CALL "callee"
+           END-CALL.
+           STOP RUN.
+           end program caller.
+
+        IDENTIFICATION   DIVISION.
+        PROGRAM-ID.      callee.
+        DATA             DIVISION.
+        WORKING-STORAGE  SECTION.
+        01 WRK-X         PIC 999 VALUE 5.
+        LOCAL-STORAGE    SECTION.
+        01 LCL-X         PIC 999 .
+        PROCEDURE        DIVISION.
+            display "On entry: " wrk-x
+            move wrk-x to lcl-x
+            subtract 1 from wrk-x
+            if wrk-x > 0
+                call "callee".
+            display "On exit: " lcl-x
+            goback.
+            end program callee.
+
diff --git a/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__3__with_recursive_PROGRAM-ID.out b/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__3__with_recursive_PROGRAM-ID.out

new file mode 100644 (file)

index 0000000..839de4f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__3__with_recursive_PROGRAM-ID.out
@@ -0,0 +1,11 @@
+On entry: 005
+On entry: 004
+On entry: 003
+On entry: 002
+On entry: 001
+On exit: 001
+On exit: 002
+On exit: 003
+On exit: 004
+On exit: 005
+
diff --git a/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__4__with_recursive_PROGRAM-ID_..._USING.cob b/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__4__with_recursive_PROGRAM-ID_..._USING.cob

new file mode 100644 (file)

index 0000000..64d0072
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__4__with_recursive_PROGRAM-ID_..._USING.cob
@@ -0,0 +1,28 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/LOCAL-STORAGE__4__with_recursive_PROGRAM-ID_..._USING.out" }
+
+        IDENTIFICATION   DIVISION.
+        PROGRAM-ID.      caller.
+        PROCEDURE        DIVISION.
+           CALL "callee"
+           END-CALL.
+           STOP RUN.
+           end program caller.
+
+        IDENTIFICATION   DIVISION.
+        PROGRAM-ID.      callee.
+        DATA             DIVISION.
+        WORKING-STORAGE  SECTION.
+        01 WRK-X         PIC 999 VALUE 5.
+        LOCAL-STORAGE    SECTION.
+        01 LCL-X         PIC 999 .
+        PROCEDURE        DIVISION.
+            display "On entry: " wrk-x
+            move wrk-x to lcl-x
+            subtract 1 from wrk-x
+            if wrk-x > 0
+                call "callee".
+            display "On exit: " lcl-x
+            goback.
+            end program callee.
+
diff --git a/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__4__with_recursive_PROGRAM-ID_..._USING.out b/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__4__with_recursive_PROGRAM-ID_..._USING.out

new file mode 100644 (file)

index 0000000..839de4f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__4__with_recursive_PROGRAM-ID_..._USING.out
@@ -0,0 +1,11 @@
+On entry: 005
+On entry: 004
+On entry: 003
+On entry: 002
+On entry: 001
+On exit: 001
+On exit: 002
+On exit: 003
+On exit: 004
+On exit: 005
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_Z_literal_.cob b/gcc/testsuite/cobol.dg/group2/MOVE_Z_literal_.cob

new file mode 100644 (file)

index 0000000..c92ab35
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_Z_literal_.cob
@@ -0,0 +1,34 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/MOVE_Z_literal_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  X            PIC XXXX.
+       01  XRED REDEFINES X.
+           03  XBYTE1   PIC X.
+           03  XBYTE2   PIC X.
+           03  XBYTE3   PIC X.
+           03  XBYTE4   PIC X.
+       PROCEDURE        DIVISION.
+           MOVE Z"012" TO X.
+           IF XBYTE1 = "0" AND
+              XBYTE2 = "1" AND
+              XBYTE3 = "2" AND
+              XBYTE4 = LOW-VALUE
+              DISPLAY "OK" NO ADVANCING
+              END-DISPLAY
+           ELSE
+              DISPLAY "X = " X (1:3) NO ADVANCING
+              END-DISPLAY
+              IF XBYTE4 = LOW-VALUE
+                 DISPLAY " WITH LOW-VALUE"
+                 END-DISPLAY
+              ELSE
+                 DISPLAY " WITHOUT LOW-VALUE BUT '" XBYTE4 "'"
+                 END-DISPLAY
+              END-IF
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_Z_literal_.out b/gcc/testsuite/cobol.dg/group2/MOVE_Z_literal_.out

new file mode 100644 (file)

index 0000000..d86bac9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_Z_literal_.out
@@ -0,0 +1 @@
+OK
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_indexes.cob b/gcc/testsuite/cobol.dg/group2/MOVE_indexes.cob

new file mode 100644 (file)

index 0000000..9ededd2
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_indexes.cob
@@ -0,0 +1,17 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 G.
+         02 X           PIC X OCCURS 10 INDEXED I.
+       PROCEDURE        DIVISION.
+           SET I TO ZERO.
+           SET X(1) TO I
+           IF X(1) NOT = "0"
+              DISPLAY X(1) NO ADVANCING
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_integer_literal_to_alphanumeric.cob b/gcc/testsuite/cobol.dg/group2/MOVE_integer_literal_to_alphanumeric.cob

new file mode 100644 (file)

index 0000000..61be48f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_integer_literal_to_alphanumeric.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/MOVE_integer_literal_to_alphanumeric.out" }
+
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  X            PIC X(04) VALUE SPACES.
+       PROCEDURE        DIVISION.
+           MOVE 0 TO X.
+           DISPLAY X NO ADVANCING
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_integer_literal_to_alphanumeric.out b/gcc/testsuite/cobol.dg/group2/MOVE_integer_literal_to_alphanumeric.out

new file mode 100644 (file)

index 0000000..4af5951
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_integer_literal_to_alphanumeric.out
@@ -0,0 +1 @@
+0   
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_to_JUSTIFIED_item.cob b/gcc/testsuite/cobol.dg/group2/MOVE_to_JUSTIFIED_item.cob

new file mode 100644 (file)

index 0000000..37f813f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_to_JUSTIFIED_item.cob
@@ -0,0 +1,31 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/MOVE_to_JUSTIFIED_item.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  SRC-1        PIC S9(04)          VALUE  11.
+       01  SRC-2        PIC S9(04) COMP     VALUE  22.
+       01  SRC-3        PIC S9(04) COMP-5   VALUE  33.
+       01  SRC-4        PIC S9(04)PP        VALUE  4400.
+       01  SRC-5        PIC S9(04)PPPPP     VALUE  55500000.
+       01  EDT-FLD      PIC X(07)           JUSTIFIED RIGHT.
+       PROCEDURE        DIVISION.
+           MOVE SRC-1   TO EDT-FLD.
+           DISPLAY '>' EDT-FLD '<'
+           END-DISPLAY.
+           MOVE SRC-2   TO EDT-FLD.
+           DISPLAY '>' EDT-FLD '<'
+           END-DISPLAY.
+           MOVE SRC-3   TO EDT-FLD.
+           DISPLAY '>' EDT-FLD '<'
+           END-DISPLAY.
+           MOVE SRC-4   TO EDT-FLD.
+           DISPLAY '>' EDT-FLD '<'
+           END-DISPLAY.
+           MOVE SRC-5   TO EDT-FLD.
+           DISPLAY '>' EDT-FLD '<'
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_to_JUSTIFIED_item.out b/gcc/testsuite/cobol.dg/group2/MOVE_to_JUSTIFIED_item.out

new file mode 100644 (file)

index 0000000..5e300fa
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_to_JUSTIFIED_item.out
@@ -0,0 +1,6 @@
+>   0011<
+>   0022<
+>   0033<
+> 004400<
+>5500000<
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__1_.cob b/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__1_.cob

new file mode 100644 (file)

index 0000000..86ef0ae
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__1_.cob
@@ -0,0 +1,35 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/MOVE_to_edited_item__1_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  SRC-1        PIC S99V99  VALUE   1.10.
+       01  SRC-2        PIC S99V99  VALUE   0.02.
+       01  SRC-3        PIC S99V99  VALUE  -0.03.
+       01  SRC-4        PIC S99V99  VALUE  -0.04.
+       01  SRC-5        PIC S99V99  VALUE  -0.05.
+       01  EDT-1        PIC -(04)9.
+       01  EDT-2        PIC -(04)9.
+       01  EDT-3        PIC -(04)9.
+       01  EDT-4        PIC +(04)9.
+       01  EDT-5        PIC -(05).
+       PROCEDURE        DIVISION.
+           MOVE SRC-1   TO EDT-1.
+           MOVE SRC-2   TO EDT-2.
+           MOVE SRC-3   TO EDT-3.
+           MOVE SRC-4   TO EDT-4.
+           MOVE SRC-5   TO EDT-5.
+           DISPLAY '>' EDT-1 '<'
+           END-DISPLAY.
+           DISPLAY '>' EDT-2 '<'
+           END-DISPLAY.
+           DISPLAY '>' EDT-3 '<'
+           END-DISPLAY.
+           DISPLAY '>' EDT-4 '<'
+           END-DISPLAY.
+           DISPLAY '>' EDT-5 '<'
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__1_.out b/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__1_.out

new file mode 100644 (file)

index 0000000..9557d50
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__1_.out
@@ -0,0 +1,6 @@
+>    1<
+>    0<
+>    0<
+>   +0<
+>     <
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__2_.cob b/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__2_.cob

new file mode 100644 (file)

index 0000000..cde8096
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__2_.cob
@@ -0,0 +1,35 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/MOVE_to_edited_item__2_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  SRC-1        PIC S99V99  VALUE  -0.06.
+       01  SRC-2        PIC S99V99  VALUE  -0.07.
+       01  SRC-3        PIC S99V99  VALUE  -0.08.
+       01  SRC-4        PIC S99V99  VALUE  -0.09.
+       01  SRC-5        PIC S99V99  VALUE  -1.10.
+       01  EDT-1        PIC 9(04)-.
+       01  EDT-2        PIC 9(04)+.
+       01  EDT-3        PIC Z(04)+.
+       01  EDT-4        PIC 9(04)DB.
+       01  EDT-5        PIC 9(04)DB.
+       PROCEDURE        DIVISION.
+           MOVE SRC-1   TO EDT-1.
+           MOVE SRC-2   TO EDT-2.
+           MOVE SRC-3   TO EDT-3.
+           MOVE SRC-4   TO EDT-4.
+           MOVE SRC-5   TO EDT-5.
+           DISPLAY '>' EDT-1 '<'
+           END-DISPLAY.
+           DISPLAY '>' EDT-2 '<'
+           END-DISPLAY.
+           DISPLAY '>' EDT-3 '<'
+           END-DISPLAY.
+           DISPLAY '>' EDT-4 '<'
+           END-DISPLAY.
+           DISPLAY '>' EDT-5 '<'
+           END-DISPLAY.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__2_.out b/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__2_.out

new file mode 100644 (file)

index 0000000..a704296
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__2_.out
@@ -0,0 +1,6 @@
+>0000 <
+>0000+<
+>     <
+>0000  <
+>0001DB<
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_to_item_with_simple_and_floating_insertion.cob b/gcc/testsuite/cobol.dg/group2/MOVE_to_item_with_simple_and_floating_insertion.cob

new file mode 100644 (file)

index 0000000..92711a9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_to_item_with_simple_and_floating_insertion.cob
@@ -0,0 +1,23 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/MOVE_to_item_with_simple_and_floating_insertion.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  num-1 PIC -*B*99.
+       01  num-2 PIC $BB**,***.**.
+       01  num-3 PIC $BB--,---.--.
+
+       PROCEDURE DIVISION.
+           MOVE -123 TO num-1
+           DISPLAY ">" num-1 "<"
+
+           MOVE 1234.56 TO num-2
+           DISPLAY ">" num-2 "<"
+
+           MOVE 1234.56 TO num-3
+           DISPLAY ">" num-3 "<"
+           .
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_to_item_with_simple_and_floating_insertion.out b/gcc/testsuite/cobol.dg/group2/MOVE_to_item_with_simple_and_floating_insertion.out

new file mode 100644 (file)

index 0000000..9012693
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_to_item_with_simple_and_floating_insertion.out
@@ -0,0 +1,4 @@
+>-**123<
+>$  *1,234.56<
+>$   1,234.56<
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_to_itself.cob b/gcc/testsuite/cobol.dg/group2/MOVE_to_itself.cob

new file mode 100644 (file)

index 0000000..475b5d9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_to_itself.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC 99 VALUE 12.
+       PROCEDURE        DIVISION.
+           MOVE X TO X.
+           IF X NOT = 12
+              DISPLAY X NO ADVANCING
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_with_group_refmod.cob b/gcc/testsuite/cobol.dg/group2/MOVE_with_group_refmod.cob

new file mode 100644 (file)

index 0000000..834d81d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_with_group_refmod.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 G.
+         02 X           PIC 9999 VALUE 1234.
+       PROCEDURE        DIVISION.
+           MOVE "99" TO G(3:2).
+           IF G NOT = "1299"
+              DISPLAY G NO ADVANCING
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_with_refmod.cob b/gcc/testsuite/cobol.dg/group2/MOVE_with_refmod.cob

new file mode 100644 (file)

index 0000000..455951a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_with_refmod.cob
@@ -0,0 +1,15 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC 9(4) VALUE 0.
+       PROCEDURE        DIVISION.
+           MOVE "1" TO X(1:1).
+           IF X NOT = 1000
+              DISPLAY X NO ADVANCING
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/MOVE_with_refmod__variable_.cob b/gcc/testsuite/cobol.dg/group2/MOVE_with_refmod__variable_.cob

new file mode 100644 (file)

index 0000000..b3fb550
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/MOVE_with_refmod__variable_.cob
@@ -0,0 +1,17 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X             PIC X(4) VALUE "1234".
+       01 Y             PIC X(4) VALUE "abcd".
+       01 I             PIC 9 VALUE 1.
+       PROCEDURE        DIVISION.
+           MOVE X(1:I) TO Y.
+           IF Y NOT = "1   "
+              DISPLAY Y NO ADVANCING
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Multi-target_MOVE_with_subscript_re-evaluation.cob b/gcc/testsuite/cobol.dg/group2/Multi-target_MOVE_with_subscript_re-evaluation.cob

new file mode 100644 (file)

index 0000000..6aa9388
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Multi-target_MOVE_with_subscript_re-evaluation.cob
@@ -0,0 +1,35 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Multi-target_MOVE_with_subscript_re-evaluation.out" }
+
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID.  mover.
+        DATA DIVISION.
+        WORKING-STORAGE SECTION.
+        01 FILLER.
+          02 ADATA VALUE "654321".
+          02 A REDEFINES ADATA PIC 9 OCCURS 6 TIMES.
+          02 B PIC 9.
+          02 CDATA VALUE "999999".
+          02 C REDEFINES CDATA PIC 9 OCCURS 6 TIMES.
+        01 TEMP PIC 9.
+        PROCEDURE DIVISION.
+        INITIALIZE CDATA ALL TO VALUE
+        MOVE 2 TO B
+        MOVE A(B) TO B, C(B)
+      *> That should pick up 5, move it to B, and then move 5 to C(5),
+        IF CDATA NOT EQUAL TO "999959"
+            DISPLAY CDATA " Should be ""999959"", but isn't"
+        ELSE
+            DISPLAY CDATA " Should be ""999959""".
+      *> See 14.9.25.4 MOVE General Rules
+        INITIALIZE CDATA ALL TO VALUE
+        MOVE 2 TO B
+        MOVE A(B) TO TEMP
+        MOVE TEMP TO B
+        MOVE TEMP TO C(B)
+        IF CDATA NOT EQUAL TO "999959"
+            DISPLAY CDATA " Should be ""999959"", but isn't"
+        ELSE
+            DISPLAY CDATA " Should be ""999959""".
+        STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Multi-target_MOVE_with_subscript_re-evaluation.out b/gcc/testsuite/cobol.dg/group2/Multi-target_MOVE_with_subscript_re-evaluation.out

new file mode 100644 (file)

index 0000000..30076d7
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Multi-target_MOVE_with_subscript_re-evaluation.out
@@ -0,0 +1,3 @@
+999959 Should be "999959"
+999959 Should be "999959"
+
diff --git a/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__1_.cob b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__1_.cob

new file mode 100644 (file)

index 0000000..6b38f79
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__1_.cob
@@ -0,0 +1,27 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Non-numeric_data_in_numeric_items__1_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X.
+          03 X-NUM      PIC 9(06) VALUE 123.
+       77 NUM           PIC 9(06).
+       PROCEDURE        DIVISION.
+           MOVE x"0000" TO X (2:2)
+           IF X-NUM NUMERIC
+              DISPLAY "low-value is numeric" UPON SYSERR
+              END-DISPLAY
+           END-IF
+           MOVE x"01" TO X (3:1)
+           IF X-NUM NUMERIC
+              DISPLAY "SOH is numeric" UPON SYSERR
+              END-DISPLAY
+           END-IF
+           MOVE X-NUM TO NUM
+           DISPLAY "test over"
+           END-DISPLAY
+      *
+           GOBACK.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__1_.out b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__1_.out

new file mode 100644 (file)

index 0000000..ac61d84
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__1_.out
@@ -0,0 +1,2 @@
+test over
+
diff --git a/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.cob b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.cob

new file mode 100644 (file)

index 0000000..e80071f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.cob
@@ -0,0 +1,22 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Non-numeric_data_in_numeric_items__2_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog2.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 X.
+          03 X-NUM      PIC 9(06) PACKED-DECIMAL VALUE 123.
+       77 NUM           PIC 9(06).
+       PROCEDURE        DIVISION.
+           MOVE x"0A" TO X (2:1)
+           IF X-NUM NUMERIC
+              DISPLAY "bad prog"
+              END-DISPLAY
+           END-IF
+           MOVE X-NUM TO NUM
+           DISPLAY "test over"
+           END-DISPLAY
+      *
+           GOBACK.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.out b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.out

new file mode 100644 (file)

index 0000000..ac61d84
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.out
@@ -0,0 +1,2 @@
+test over
+
diff --git a/gcc/testsuite/cobol.dg/group2/Non-overflow_after_overflow.cob b/gcc/testsuite/cobol.dg/group2/Non-overflow_after_overflow.cob

new file mode 100644 (file)

index 0000000..fb6cdc7
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Non-overflow_after_overflow.cob
@@ -0,0 +1,19 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  X            PIC 9(2) VALUE 0.
+       01  Y            PIC 9(2) VALUE 0.
+       PROCEDURE        DIVISION.
+           COMPUTE X = 100
+           END-COMPUTE.
+           COMPUTE Y = 99
+           END-COMPUTE.
+           IF Y NOT = 99
+              DISPLAY Y NO ADVANCING
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/OCCURS_clause_with_1_entry.cob b/gcc/testsuite/cobol.dg/group2/OCCURS_clause_with_1_entry.cob

new file mode 100644 (file)

index 0000000..f244407
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/OCCURS_clause_with_1_entry.cob
@@ -0,0 +1,40 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  D1.
+           03  FILLER   OCCURS 1.
+               05 D1-ENTRY   PIC X(03) value '123'.
+       01  D2.
+           03  D2-ENTRY   PIC X(03)  value 'ABC'  OCCURS 1.
+       01  D1TOR.
+           03  FILLER   PIC X(03) value '456'.
+       01  D1-R         REDEFINES D1TOR.
+           03  FILLER   OCCURS 1.
+               05 D1-R-ENTRY   PIC X(03).
+       01  D2TOR.
+           03  FILLER   PIC X(03) value 'DEF'.
+       01  D2-R         REDEFINES D2TOR.
+           03  D2-R-ENTRY   PIC X(03)   OCCURS 1.
+
+       PROCEDURE        DIVISION.
+           IF D1-ENTRY (1) NOT = "123"
+              DISPLAY D1-ENTRY (1)
+              END-DISPLAY
+           END-IF.
+           IF D2-ENTRY (1) NOT = "ABC"
+              DISPLAY D2-ENTRY (1)
+              END-DISPLAY
+           END-IF.
+           IF D1-R-ENTRY (1) NOT = "456"
+              DISPLAY D1-R-ENTRY (1)
+              END-DISPLAY
+           END-IF.
+           IF D2-R-ENTRY (1) NOT = "DEF"
+              DISPLAY D2-R-ENTRY (1)
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/OSVS_Arithmetic_Test__2_.cob b/gcc/testsuite/cobol.dg/group2/OSVS_Arithmetic_Test__2_.cob

new file mode 100644 (file)

index 0000000..ff047bf
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/OSVS_Arithmetic_Test__2_.cob
@@ -0,0 +1,40 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/OSVS_Arithmetic_Test__2_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID. prog.
+       ENVIRONMENT      DIVISION.
+       DATA             DIVISION.
+       WORKING-STORAGE SECTION.
+       01  VAL                 PIC S9(7)V99 COMP-3 VALUE 20500.
+       01  DIV1                PIC S9(7)V99 COMP-3 VALUE 0.9.
+       01  DIV2                PIC S9(7)V99 COMP-3 VALUE 33.45.
+       01  DIV3                PIC S9(7)V99 COMP-3 VALUE 9.
+       01  MUL1                PIC S9(7)V99 COMP-3 VALUE 10.
+       01  MUL2                PIC S9(7)V99 COMP-3 VALUE 5.
+       01  MUL3                PIC S9(7)V99 COMP-3 VALUE 2.
+       01  RES                 PIC S9(7)V99 COMP-3.
+       PROCEDURE        DIVISION.
+           COMPUTE RES = VAL / DIV1 / DIV2.
+           DISPLAY 'RES = ' RES.
+           COMPUTE RES ROUNDED = VAL / DIV1 / DIV2.
+           DISPLAY 'RES ROUNDED = ' RES.
+           COMPUTE RES = VAL * MUL1 / DIV3 / DIV2.
+           DISPLAY 'RES MULT1 = ' RES.
+           COMPUTE RES = VAL * MUL2 * MUL3 / DIV3 / DIV2.
+           DISPLAY 'RES MULT2 = ' RES.
+           COMPUTE RES = VAL / DIV1.
+           DISPLAY 'RES 1 = ' RES.
+           COMPUTE RES = RES / DIV2.
+           DISPLAY 'RES F = ' RES.
+           COMPUTE RES  =
+                VAL / DIV1 / DIV2.
+           DISPLAY 'RES NOT ROUNDED = ' RES.
+           COMPUTE RES ROUNDED MODE NEAREST-AWAY-FROM-ZERO =
+                VAL / DIV1 / DIV2.
+           DISPLAY 'RES ROUNDED NEAREST-AWAY = ' RES.
+           COMPUTE RES ROUNDED MODE AWAY-FROM-ZERO =
+                VAL / DIV1 / DIV2.
+           DISPLAY 'RES ROUNDED AWAY = ' RES.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/OSVS_Arithmetic_Test__2_.out b/gcc/testsuite/cobol.dg/group2/OSVS_Arithmetic_Test__2_.out

new file mode 100644 (file)

index 0000000..d0816cd
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/OSVS_Arithmetic_Test__2_.out
@@ -0,0 +1,10 @@
+RES = +0000680.95
+RES ROUNDED = +0000680.95
+RES MULT1 = +0000680.95
+RES MULT2 = +0000680.95
+RES 1 = +0022777.77
+RES F = +0000680.94
+RES NOT ROUNDED = +0000680.95
+RES ROUNDED NEAREST-AWAY = +0000680.95
+RES ROUNDED AWAY = +0000680.96
+
diff --git a/gcc/testsuite/cobol.dg/group2/PERFORM_..._CONTINUE.cob b/gcc/testsuite/cobol.dg/group2/PERFORM_..._CONTINUE.cob

new file mode 100644 (file)

index 0000000..5f39fc5
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/PERFORM_..._CONTINUE.cob
@@ -0,0 +1,9 @@
+      *> { dg-do compile }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       PROCEDURE        DIVISION.
+           PERFORM 2 TIMES
+             CONTINUE
+           END-PERFORM.
+
diff --git a/gcc/testsuite/cobol.dg/group2/PERFORM_inline__1_.cob b/gcc/testsuite/cobol.dg/group2/PERFORM_inline__1_.cob

new file mode 100644 (file)

index 0000000..7f6f3aa
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/PERFORM_inline__1_.cob
@@ -0,0 +1,19 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  INDVAL       PIC 9(4).
+       PROCEDURE        DIVISION.
+           PERFORM VARYING INDVAL FROM 1
+            BY 1 UNTIL INDVAL > 2
+           CONTINUE
+           END-PERFORM
+           IF INDVAL NOT = 3
+              DISPLAY INDVAL NO ADVANCING
+              END-DISPLAY
+           END-IF
+           STOP RUN
+           .
+
diff --git a/gcc/testsuite/cobol.dg/group2/PERFORM_inline__2_.cob b/gcc/testsuite/cobol.dg/group2/PERFORM_inline__2_.cob

new file mode 100644 (file)

index 0000000..e3e0458
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/PERFORM_inline__2_.cob
@@ -0,0 +1,18 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  INDVAL       PIC 9(4).
+       PROCEDURE        DIVISION.
+           PERFORM VARYING INDVAL FROM 1
+            BY 1 UNTIL INDVAL > 2
+            CONTINUE
+            END-PERFORM
+           IF INDVAL NOT = 3
+              DISPLAY INDVAL NO ADVANCING
+              END-DISPLAY
+           END-IF
+           .
+
diff --git a/gcc/testsuite/cobol.dg/group2/PERFORM_type_OSVS.cob b/gcc/testsuite/cobol.dg/group2/PERFORM_type_OSVS.cob

new file mode 100644 (file)

index 0000000..e64d679
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/PERFORM_type_OSVS.cob
@@ -0,0 +1,28 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  MYOCC        PIC 9(8) COMP VALUE 0.
+       PROCEDURE        DIVISION.
+       ASTART SECTION.
+       A01.
+           PERFORM BTEST.
+           IF MYOCC NOT = 2
+              DISPLAY MYOCC
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+       BTEST SECTION.
+       B01.
+           PERFORM B02 VARYING MYOCC FROM 1 BY 1
+                   UNTIL MYOCC > 5.
+           GO TO B99.
+       B02.
+           IF MYOCC > 1
+              GO TO B99
+           END-IF.
+       B99.
+           EXIT.
+
diff --git a/gcc/testsuite/cobol.dg/group2/PIC_ZZZ-__ZZZ_.cob b/gcc/testsuite/cobol.dg/group2/PIC_ZZZ-__ZZZ_.cob

new file mode 100644 (file)

index 0000000..a8ad589
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/PIC_ZZZ-__ZZZ_.cob
@@ -0,0 +1,44 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  X-ZZZN                    PIC ZZZ-.
+       01  XZN-RED REDEFINES X-ZZZN  PIC X(4).
+       01  X-ZZZP                    PIC ZZZ+.
+       01  XZP-RED REDEFINES X-ZZZP  PIC X(4).
+       PROCEDURE        DIVISION.
+           MOVE -1 TO X-ZZZN.
+           IF XZN-RED NOT = "  1-"
+              DISPLAY "(" X-ZZZN ")"
+              END-DISPLAY
+           END-IF.
+           MOVE  0 TO X-ZZZN.
+           IF XZN-RED NOT = "    "
+              DISPLAY "(" X-ZZZN ")"
+              END-DISPLAY
+           END-IF.
+           MOVE +1 TO X-ZZZN.
+           IF XZN-RED NOT = "  1 "
+              DISPLAY "(" X-ZZZN ")"
+              END-DISPLAY
+           END-IF.
+
+           MOVE -1 TO X-ZZZP.
+           IF XZP-RED NOT = "  1-"
+              DISPLAY "(" X-ZZZP ")"
+              END-DISPLAY
+           END-IF.
+           MOVE  0 TO X-ZZZP.
+           IF XZP-RED NOT = "    "
+              DISPLAY "(" X-ZZZP ")"
+              END-DISPLAY
+           END-IF.
+           MOVE +1 TO X-ZZZP.
+           IF XZP-RED NOT = "  1+"
+              DISPLAY "(" X-ZZZP ")"
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Quick_check_of_PIC_XX_COMP-5.cob b/gcc/testsuite/cobol.dg/group2/Quick_check_of_PIC_XX_COMP-5.cob

new file mode 100644 (file)

index 0000000..5e73de6
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Quick_check_of_PIC_XX_COMP-5.cob
@@ -0,0 +1,17 @@
+       *> { dg-do run }
+       *> { dg-options "-dialect mf" }
+       *> { dg-output-file "group2/Quick_check_of_PIC_XX_COMP-5.out" }
+         identification division.
+        program-id. wrapper.
+        data division.
+        working-storage section.
+        01 memx pic x(2) comp-5.
+        77 ptr pointer.
+        procedure division.
+        Initialize ptr.display "LENGTH OF X(2) is " length of memx
+        move 12345 to memx
+        display memx
+        IF ptr <> NULL then display 'bad pointer'.
+        goback.
+        end program wrapper.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Quick_check_of_PIC_XX_COMP-5.out b/gcc/testsuite/cobol.dg/group2/Quick_check_of_PIC_XX_COMP-5.out

new file mode 100644 (file)

index 0000000..a79f3be
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Quick_check_of_PIC_XX_COMP-5.out
@@ -0,0 +1,3 @@
+LENGTH OF X(2) is 2
+12345
+
diff --git a/gcc/testsuite/cobol.dg/group2/Quote_marks_in_comment_paragraphs.cob b/gcc/testsuite/cobol.dg/group2/Quote_marks_in_comment_paragraphs.cob

new file mode 100644 (file)

index 0000000..70564e4
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Quote_marks_in_comment_paragraphs.cob
@@ -0,0 +1,11 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Quote_marks_in_comment_paragraphs.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID.    prog.
+       DATE-written.  hello'".
+      *> Written is intentionally lowercase.
+      *> extra " to fix syntax highlighting
+       PROCEDURE      DIVISION.
+           DISPLAY "Hello, world!".
+
diff --git a/gcc/testsuite/cobol.dg/group2/Quote_marks_in_comment_paragraphs.out b/gcc/testsuite/cobol.dg/group2/Quote_marks_in_comment_paragraphs.out

new file mode 100644 (file)

index 0000000..297edb3
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Quote_marks_in_comment_paragraphs.out
@@ -0,0 +1,2 @@
+Hello, world!
+
diff --git a/gcc/testsuite/cobol.dg/group2/REDEFINES_values_on_FILLER_and_INITIALIZE.cob b/gcc/testsuite/cobol.dg/group2/REDEFINES_values_on_FILLER_and_INITIALIZE.cob

new file mode 100644 (file)

index 0000000..2367ad5
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/REDEFINES_values_on_FILLER_and_INITIALIZE.cob
@@ -0,0 +1,38 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/REDEFINES_values_on_FILLER_and_INITIALIZE.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA  DIVISION.
+       WORKING-STORAGE SECTION.
+       01  TSRDF.
+           05  WS-ASK-ID-DATE                PIC X(10).
+           05  WS-ASK-ID-DATE-R              REDEFINES WS-ASK-ID-DATE.
+               10  WS-ASK-ID-DATE-YYYY       PIC 9(4) VALUE 2017.
+               10  FILLER                    PIC X VALUE '-'.
+               10  WS-ASK-ID-DATE-MM         PIC 9(2).
+               10  FILLER                    PIC X VALUE '-'.
+               10  WS-ASK-ID-DATE-DD         PIC 9(2).
+       PROCEDURE DIVISION.
+           MOVE ALL '*' TO WS-ASK-ID-DATE
+           MOVE 2015 TO WS-ASK-ID-DATE-YYYY
+           MOVE 08 TO WS-ASK-ID-DATE-MM
+           MOVE 21 TO WS-ASK-ID-DATE-DD
+           DISPLAY "The date is " WS-ASK-ID-DATE " Compiled".
+
+           INITIALIZE WS-ASK-ID-DATE-R.
+           MOVE 08 TO WS-ASK-ID-DATE-MM
+           MOVE 21 TO WS-ASK-ID-DATE-DD
+           DISPLAY "The date is " WS-ASK-ID-DATE " INITIALIZE".
+
+           INITIALIZE WS-ASK-ID-DATE-R WITH FILLER.
+           MOVE 08 TO WS-ASK-ID-DATE-MM
+           MOVE 21 TO WS-ASK-ID-DATE-DD
+           DISPLAY "The date is " WS-ASK-ID-DATE " WITH FILLER".
+
+           INITIALIZE WS-ASK-ID-DATE-R WITH FILLER ALL TO VALUE.
+           MOVE 08 TO WS-ASK-ID-DATE-MM
+           MOVE 21 TO WS-ASK-ID-DATE-DD
+           DISPLAY "The date is " WS-ASK-ID-DATE " ALL TO VALUE".
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/REDEFINES_values_on_FILLER_and_INITIALIZE.out b/gcc/testsuite/cobol.dg/group2/REDEFINES_values_on_FILLER_and_INITIALIZE.out

new file mode 100644 (file)

index 0000000..6a24172
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/REDEFINES_values_on_FILLER_and_INITIALIZE.out
@@ -0,0 +1,5 @@
+The date is 2015*08*21 Compiled
+The date is 0000*08*21 INITIALIZE
+The date is 0000 08 21 WITH FILLER
+The date is 2017-08-21 ALL TO VALUE
+
diff --git a/gcc/testsuite/cobol.dg/group2/Recursive_PERFORM_paragraph.cob b/gcc/testsuite/cobol.dg/group2/Recursive_PERFORM_paragraph.cob

new file mode 100644 (file)

index 0000000..3eb0685
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Recursive_PERFORM_paragraph.cob
@@ -0,0 +1,22 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Recursive_PERFORM_paragraph.out" }
+        identification      division.
+        program-id.         prog.
+        data                division.
+        working-storage     section.
+        77 n binary-double unsigned.
+        77 f binary-double unsigned.
+        procedure           division.
+        move 20 to n
+        move 1 to f
+        display "compute " n " factorial".
+        fact.
+            compute f = f * n
+            subtract 1 from n
+            if n not equal to zero then 
+                perform fact
+            end-if.
+        end-fact.
+        display f.
+        end program         prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Recursive_PERFORM_paragraph.out b/gcc/testsuite/cobol.dg/group2/Recursive_PERFORM_paragraph.out

new file mode 100644 (file)

index 0000000..97f0737
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Recursive_PERFORM_paragraph.out
@@ -0,0 +1,3 @@
+compute 0000000000000000020 factorial
+2432902008176640000
+
diff --git a/gcc/testsuite/cobol.dg/group2/SORT__EBCDIC_table_sort__1_.cob b/gcc/testsuite/cobol.dg/group2/SORT__EBCDIC_table_sort__1_.cob

new file mode 100644 (file)

index 0000000..9bf4892
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/SORT__EBCDIC_table_sort__1_.cob
@@ -0,0 +1,29 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+       SPECIAL-NAMES.
+           ALPHABET ALPHA IS EBCDIC.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 Z  PIC X(10)  VALUE "d4b2e1a3c5".
+       01 G.
+         02 TBL         OCCURS 10.
+           03 X         PIC X.
+       PROCEDURE        DIVISION.
+           MOVE Z TO G.
+           SORT TBL ASCENDING KEY X SEQUENCE ALPHA.
+           IF G NOT = "abcde12345"
+              DISPLAY G
+              END-DISPLAY
+           END-IF.
+           MOVE Z TO G.
+           SORT TBL DESCENDING KEY X SEQUENCE ALPHA.
+           IF G NOT = "54321edcba"
+              DISPLAY G
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/SORT__EBCDIC_table_sort__2_.cob b/gcc/testsuite/cobol.dg/group2/SORT__EBCDIC_table_sort__2_.cob

new file mode 100644 (file)

index 0000000..2a10d2d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/SORT__EBCDIC_table_sort__2_.cob
@@ -0,0 +1,27 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       ENVIRONMENT DIVISION.
+       CONFIGURATION SECTION.
+           OBJECT-COMPUTER.
+             x86 PROGRAM COLLATING SEQUENCE IS EBCDIC-CODE.
+       SPECIAL-NAMES.
+           ALPHABET EBCDIC-CODE IS EBCDIC.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 Z  PIC X(10)  VALUE "d4b2e1a3c5".
+       01 G.
+         02 TBL         OCCURS 10.
+           03 X         PIC X.
+       PROCEDURE        DIVISION.
+           MOVE Z TO G.
+           SORT TBL ASCENDING KEY X.
+           IF G NOT = "abcde12345"
+              DISPLAY G.
+           MOVE Z TO G.
+           SORT TBL DESCENDING KEY X.
+           IF G NOT = "54321edcba"
+              DISPLAY G.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/SORT__table_sort.cob b/gcc/testsuite/cobol.dg/group2/SORT__table_sort.cob

new file mode 100644 (file)

index 0000000..52fc973
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/SORT__table_sort.cob
@@ -0,0 +1,33 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01 G             VALUE "d4b2e1a3c5".
+         02 TBL         OCCURS 5.
+           03 X         PIC X.
+           03 Y         PIC 9.
+       PROCEDURE        DIVISION.
+           SORT TBL ASCENDING KEY X.
+           IF G NOT = "a3b2c5d4e1"
+              DISPLAY G
+              END-DISPLAY
+           END-IF.
+           SORT TBL DESCENDING KEY Y.
+           IF G NOT = "c5d4a3b2e1"
+              DISPLAY G
+              END-DISPLAY
+           END-IF.
+           SORT TBL ASCENDING KEY TBL.
+           IF G NOT = "a3b2c5d4e1"
+              DISPLAY G
+              END-DISPLAY
+           END-IF.
+           SORT TBL DESCENDING KEY.
+           IF G NOT = "e1d4c5b2a3"
+              DISPLAY G
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/SORT__table_sort__2_.cob b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__2_.cob

new file mode 100644 (file)

index 0000000..d30b4ea
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__2_.cob
@@ -0,0 +1,96 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/SORT__table_sort__2_.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       ENVIRONMENT DIVISION.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01 K                 PIC 9(2).
+
+       01 CNT1              PIC 9(9) COMP-5 VALUE 4.
+       01 TAB1.
+          05 ROW1 OCCURS 1 TO 4 DEPENDING CNT1
+                                 DESCENDING TAB1-NR.
+             10 TAB1-NR     PIC 99.
+
+       01 TAB2.
+          05 CNT2           PIC 9(9) COMP-5 VALUE 4.
+          05 ROW2 OCCURS 1 TO 4 DEPENDING CNT2
+                                 DESCENDING TAB2-NR.
+             10 TAB2-NR PIC 99.
+
+       01 TAB3.
+          05 CNT3           PIC 9(9) COMP-5 VALUE 10.
+          05 ROW3 OCCURS 1 TO 10 DEPENDING CNT3
+                                  DESCENDING TAB3-NR
+                                  ASCENDING TAB3-DATA.
+             10 TAB3-NR     PIC 99.
+             10 FILLER      PIC X(2).
+             10 TAB3-DATA   PIC X(5).
+             10 FILLER      PIC X(2).
+             10 TAB3-DATA2  PIC X(5).
+
+
+       PROCEDURE DIVISION.
+       A.
+           PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4
+             MOVE K TO TAB1-NR(K), TAB2-NR(K)
+           END-PERFORM
+
+           MOVE 1 TO TAB3-NR(1).
+           MOVE 1 TO TAB3-NR(8).
+           MOVE 1 TO TAB3-NR(4).
+           MOVE 6 TO TAB3-NR(2).
+           MOVE 5 TO TAB3-NR(3).
+           MOVE 5 TO TAB3-NR(9).
+           MOVE 2 TO TAB3-NR(5).
+           MOVE 2 TO TAB3-NR(10).
+           MOVE 4 TO TAB3-NR(6).
+           MOVE 3 TO TAB3-NR(7).
+
+           MOVE "abcde" TO TAB3-DATA(1).
+           MOVE "AbCde" TO TAB3-DATA(2).
+           MOVE "abcde" TO TAB3-DATA(3).
+           MOVE "zyx" TO TAB3-DATA(4).
+           MOVE "12345" TO TAB3-DATA(5).
+           MOVE "zyx" TO TAB3-DATA(6).
+           MOVE "abcde" TO TAB3-DATA(7).
+           MOVE "AbCde" TO TAB3-DATA(8).
+           MOVE "abc" TO TAB3-DATA(9).
+           MOVE "12346" TO TAB3-DATA(10).
+
+           MOVE "day" TO TAB3-DATA2(1).
+           MOVE "The" TO TAB3-DATA2(2).
+           MOVE "eats" TO TAB3-DATA2(3).
+           MOVE "." TO TAB3-DATA2(4).
+           MOVE "mooos" TO TAB3-DATA2(5).
+           MOVE "grass" TO TAB3-DATA2(6).
+           MOVE "and" TO TAB3-DATA2(7).
+           MOVE "whole" TO TAB3-DATA2(8).
+           MOVE "cow" TO TAB3-DATA2(9).
+           MOVE "the" TO TAB3-DATA2(10).
+
+           SORT ROW1 DESCENDING TAB1-NR
+           SORT ROW2 DESCENDING TAB2-NR
+
+           DISPLAY "SINGLE TABLE" END-DISPLAY
+           PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4
+             DISPLAY TAB1-NR(K) END-DISPLAY
+           END-PERFORM
+
+           DISPLAY "LOWER LEVEL TABLE" END-DISPLAY
+           PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4
+             DISPLAY  TAB2-NR(K) END-DISPLAY
+           END-PERFORM
+
+           SORT ROW3 DESCENDING TAB3-NR ASCENDING TAB3-DATA
+
+           DISPLAY "MULTY KEY SORT" END-DISPLAY
+           PERFORM VARYING K FROM 1 BY 1 UNTIL K > 10
+             DISPLAY  FUNCTION TRIM(ROW3(K))
+             END-DISPLAY
+           END-PERFORM
+
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/SORT__table_sort__2_.out b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__2_.out

new file mode 100644 (file)

index 0000000..5866ecf
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__2_.out
@@ -0,0 +1,22 @@
+SINGLE TABLE
+04
+03
+02
+01
+LOWER LEVEL TABLE
+04
+03
+02
+01
+MULTY KEY SORT
+06  AbCde  The
+05  abc    cow
+05  abcde  eats
+04  zyx    grass
+03  abcde  and
+02  12345  mooos
+02  12346  the
+01  AbCde  whole
+01  abcde  day
+01  zyx    .
+
diff --git a/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3A_.cob b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3A_.cob

new file mode 100644 (file)

index 0000000..660f93c
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3A_.cob
@@ -0,0 +1,48 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/SORT__table_sort__3A_.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       ENVIRONMENT DIVISION.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01 K                 PIC 9(2).
+
+       01 CNT1              PIC 9(9) COMP-5 VALUE 4.
+       01 TAB1.
+          05 ROW1 OCCURS 1 TO 4 DEPENDING CNT1
+                                  DESCENDING TAB1-NR.
+             10 TAB1-NR     PIC 99.
+             10 TAB-DATA    PIC X(5).
+       01 TAB2.
+          05 ROW2 OCCURS 1 TO 4 DEPENDING CNT1
+                                  ASCENDING ROW2.
+             10 TAB2-NR     PIC 99.
+             10 TAB2-DATA   PIC X(5).
+
+       PROCEDURE DIVISION.
+       A.
+           PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4
+             MOVE K     TO TAB1-NR (K)
+             MOVE 'BLA' TO TAB-DATA(K)
+           END-PERFORM
+
+           SORT ROW1
+
+           DISPLAY "After SORT [DESCENDING] ROW1"
+           PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4
+             DISPLAY TAB1-NR(K) NO ADVANCING END-DISPLAY
+           END-PERFORM
+           DISPLAY ""
+
+           MOVE TAB1 TO TAB2
+           SORT ROW2
+
+           DISPLAY "After SORT [ASCENDING] ROW2"
+           PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4
+             DISPLAY TAB2-NR(K) NO ADVANCING END-DISPLAY
+           END-PERFORM
+           DISPLAY ""
+
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3A_.out b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3A_.out

new file mode 100644 (file)

index 0000000..29ea985
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3A_.out
@@ -0,0 +1,5 @@
+After SORT [DESCENDING] ROW1
+04030201
+After SORT [ASCENDING] ROW2
+01020304
+
diff --git a/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3B_.cob b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3B_.cob

new file mode 100644 (file)

index 0000000..3afea83
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3B_.cob
@@ -0,0 +1,44 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/SORT__table_sort__3B_.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog2.
+       ENVIRONMENT DIVISION.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01 K                 PIC 9(2).
+
+       01 CNT1              PIC 9(9) COMP-5 VALUE 4.
+       01 TAB1.
+          05 ROW1 OCCURS 5        DESCENDING TAB1-NR.
+             10 TAB1-NR     PIC 99 VALUE ZERO.
+             10 TAB-DATA    PIC X(5).
+       01 TAB2.
+          05 ROW1 OCCURS 1 TO 4 DEPENDING CNT1
+                                  DESCENDING TAB1-NR.
+             10 TAB1-NR     PIC 99.
+             10 TAB-DATA    PIC X(5).
+
+       PROCEDURE DIVISION.
+       A.
+           PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4
+             MOVE K     TO TAB1-NR  OF TAB2(K)
+             MOVE 'BLA' TO TAB-DATA OF TAB2(K)
+           END-PERFORM
+
+           DISPLAY "Before sort"
+           PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4
+             DISPLAY TAB1-NR OF TAB2(K) NO ADVANCING END-DISPLAY
+           END-PERFORM
+           DISPLAY ""
+
+           SORT ROW1 OF TAB2.
+
+           DISPLAY "After descending sort"
+           PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4
+             DISPLAY TAB1-NR OF TAB2(K) NO ADVANCING END-DISPLAY
+           END-PERFORM
+           DISPLAY ""
+
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3B_.out b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3B_.out

new file mode 100644 (file)

index 0000000..4721770
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/SORT__table_sort__3B_.out
@@ -0,0 +1,5 @@
+Before sort
+01020304
+After descending sort
+04030201
+
diff --git a/gcc/testsuite/cobol.dg/group2/SOURCE_FIXED_FREE_directives.cob b/gcc/testsuite/cobol.dg/group2/SOURCE_FIXED_FREE_directives.cob

new file mode 100644 (file)

index 0000000..29b266e
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/SOURCE_FIXED_FREE_directives.cob
@@ -0,0 +1,27 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/SOURCE_FIXED_FREE_directives.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       >>SOURCE FREE
+   DATA             DIVISION.
+   WORKING-STORAGE  SECTION.
+   >>SOURCE FIXED
+       PROCEDURE        DIVISION.                                       FIXED
+             DISPLAY "OK" NO ADVANCING
+             END-DISPLAY.
+       >>SOURCE FREE
+                                                                        DISPLAY
+   "OK"
+ NO ADVANCING
+   END-DISPLAY.
+      >>SOURCE FORMAT FIXED
+             DISPLAY "OK" NO ADVANCING                                  FIXED
+             END-DISPLAY.
+       >>SOURCE FORMAT IS FREE
+                                                                        DISPLAY
+   "OK"
+ NO ADVANCING
+   END-DISPLAY.
+             STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/SOURCE_FIXED_FREE_directives.out b/gcc/testsuite/cobol.dg/group2/SOURCE_FIXED_FREE_directives.out

new file mode 100644 (file)

index 0000000..ed898e2
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/SOURCE_FIXED_FREE_directives.out
@@ -0,0 +1 @@
+OKOKOKOK
diff --git a/gcc/testsuite/cobol.dg/group2/STOP_RUN_WITH_ERROR_STATUS.cob b/gcc/testsuite/cobol.dg/group2/STOP_RUN_WITH_ERROR_STATUS.cob

new file mode 100644 (file)

index 0000000..c5f8fe7
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/STOP_RUN_WITH_ERROR_STATUS.cob
@@ -0,0 +1,10 @@
+       *> { dg-do run }
+       *> { dg-xfail-run-if "" { *-*-* }  }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       PROCEDURE        DIVISION.
+           STOP RUN WITH ERROR STATUS.
+
diff --git a/gcc/testsuite/cobol.dg/group2/STOP_RUN_WITH_NORMAL_STATUS.cob b/gcc/testsuite/cobol.dg/group2/STOP_RUN_WITH_NORMAL_STATUS.cob

new file mode 100644 (file)

index 0000000..9950a77
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/STOP_RUN_WITH_NORMAL_STATUS.cob
@@ -0,0 +1,9 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       PROCEDURE        DIVISION.
+           STOP RUN WITH NORMAL STATUS.
+
diff --git a/gcc/testsuite/cobol.dg/group2/STRING___UNSTRING__NOT__ON_OVERFLOW.cob b/gcc/testsuite/cobol.dg/group2/STRING___UNSTRING__NOT__ON_OVERFLOW.cob

new file mode 100644 (file)

index 0000000..8397189
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/STRING___UNSTRING__NOT__ON_OVERFLOW.cob
@@ -0,0 +1,104 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/STRING___UNSTRING__NOT__ON_OVERFLOW.out" }
+
+       identification division.
+       program-id. prog.
+       data division.
+       working-storage section.
+       77 simple-str     pic x(20).
+       77 err-str        pic x(50).
+      *-----------------------------------------------------------------
+       procedure division.
+      *    STRING test
+           move spaces to simple-str
+           string 'data'
+             delimited by size
+             into simple-str
+             on overflow
+               move spaces to err-str
+               string 'STRING OVERFLOW'
+                  delimited by size
+                  into err-str
+               end-string
+               display err-str upon syserr
+               end-display
+               display '1 failed'
+               end-display
+             not on overflow
+               display '1 passed'
+               end-display
+           end-string
+           if simple-str not = 'data'
+             display 'STRING ERROR (1): "' simple-str '"'
+             end-display
+           end-if
+      *
+           move spaces to simple-str
+           string 'data is too big here...'
+             delimited by size
+             into simple-str
+             on overflow
+               display '2 passed'
+               end-display
+             not on overflow
+               display '2 failed'
+               end-display
+               move spaces to err-str
+               string 'missing OVERFLOW'
+                  delimited by size
+                  into err-str
+               end-string
+               display err-str upon syserr
+               end-display
+           end-string
+           if simple-str not = 'data is too big here'
+             display 'STRING ERROR (2): "' simple-str '"'
+             end-display
+           end-if
+      *
+      *    UNSTRING test
+           move spaces to simple-str
+           unstring 'data'
+             into simple-str
+             on overflow
+               move spaces to err-str
+               unstring 'UNSTRING OVERFLOW'
+                  into err-str
+               end-unstring
+               display err-str upon syserr
+               end-display
+               display '3 failed'
+               end-display
+             not on overflow
+               display '3 passed'
+               end-display
+           end-unstring
+           if simple-str not = 'data'
+             display 'UNSTRING ERROR (1): "' simple-str '"'
+             end-display
+           end-if
+      *
+           move spaces to simple-str
+           unstring 'data is too big here...'
+             into simple-str
+             on overflow
+               display '4 passed'
+               end-display
+             not on overflow
+               display '4 failed'
+               end-display
+               move spaces to err-str
+               string 'missing OVERFLOW'
+                  delimited by size
+                  into err-str
+               end-string
+               display err-str upon syserr
+               end-display
+           end-unstring
+           if simple-str not = 'data is too big here'
+             display 'UNSTRING ERROR (2): "' simple-str '"'
+             end-display
+           end-if
+      *
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/STRING___UNSTRING__NOT__ON_OVERFLOW.out b/gcc/testsuite/cobol.dg/group2/STRING___UNSTRING__NOT__ON_OVERFLOW.out

new file mode 100644 (file)

index 0000000..f819dc4
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/STRING___UNSTRING__NOT__ON_OVERFLOW.out
@@ -0,0 +1,5 @@
+1 passed
+2 passed
+3 passed
+4 passed
+
diff --git a/gcc/testsuite/cobol.dg/group2/STRING_with_subscript_reference.cob b/gcc/testsuite/cobol.dg/group2/STRING_with_subscript_reference.cob

new file mode 100644 (file)

index 0000000..66a5477
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/STRING_with_subscript_reference.cob
@@ -0,0 +1,18 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  G.
+           02 X         PIC X(3) OCCURS 3.
+       PROCEDURE        DIVISION.
+           MOVE   SPACES TO G.
+           STRING "abc" INTO X(2)
+           END-STRING.
+           IF G NOT = "   abc   "
+              DISPLAY X(1) NO ADVANCING
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Static_CALL_with_ON_EXCEPTION__with_-fno-static-call_.cob b/gcc/testsuite/cobol.dg/group2/Static_CALL_with_ON_EXCEPTION__with_-fno-static-call_.cob

new file mode 100644 (file)

index 0000000..fa43889
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Static_CALL_with_ON_EXCEPTION__with_-fno-static-call_.cob
@@ -0,0 +1,20 @@
+       *> { dg-do run }
+       *> { dg-options "-fno-static-call -rdynamic" }
+       *> { dg-output-file "group2/Static_CALL_with_ON_EXCEPTION__with_-fno-static-call_.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      caller.
+       PROCEDURE        DIVISION.
+           CALL "callee1" ON EXCEPTION
+              CALL "callee2" ON EXCEPTION
+                  DISPLAY "neither callee1 nor callee2 found"
+              END-CALL
+           END-CALL
+           GOBACK.
+       END PROGRAM caller.
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      callee2.
+       PROCEDURE        DIVISION.
+           DISPLAY "this is callee2" NO ADVANCING
+           GOBACK.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Static_CALL_with_ON_EXCEPTION__with_-fno-static-call_.out b/gcc/testsuite/cobol.dg/group2/Static_CALL_with_ON_EXCEPTION__with_-fno-static-call_.out

new file mode 100644 (file)

index 0000000..4f18f54
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Static_CALL_with_ON_EXCEPTION__with_-fno-static-call_.out
@@ -0,0 +1 @@
+this is callee2
diff --git a/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_ALL_LOW-VALUE.cob b/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_ALL_LOW-VALUE.cob

new file mode 100644 (file)

index 0000000..495feef
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_ALL_LOW-VALUE.cob
@@ -0,0 +1,26 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  G.
+           03 FILLER    PIC XXX VALUE "ABC".
+           03 FILLER    PIC XX  VALUE LOW-VALUE.
+           03 FILLER    PIC XXX VALUE "DEF".
+       01  A            PIC XXX.
+       01  B            PIC XXX.
+       PROCEDURE        DIVISION.
+           UNSTRING G DELIMITED BY ALL LOW-VALUE
+                      INTO A B
+           END-UNSTRING.
+           IF A NOT = "ABC"
+              DISPLAY "A is " """" A """"
+              END-DISPLAY
+           END-IF.
+           IF B NOT = "DEF"
+              DISPLAY "B is " """" B """"
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_ALL_SPACE-2.cob b/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_ALL_SPACE-2.cob

new file mode 100644 (file)

index 0000000..9bbbd8e
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_ALL_SPACE-2.cob
@@ -0,0 +1,56 @@
+       *> { dg-do run }
+
+       IDENTIFICATION  DIVISION.
+       PROGRAM-ID.     prog.
+       ENVIRONMENT     DIVISION.
+       DATA            DIVISION.
+       WORKING-STORAGE SECTION.
+       01  WS-RECORD.
+           02 VALUE SPACE           PIC X(04).
+           02 VALUE "ABC AND DE"    PIC X(10).
+           02 VALUE SPACE           PIC X(07).
+           02 VALUE "FG AND HIJ"    PIC X(10).
+           02 VALUE SPACE           PIC X(08).
+       01  SPACE-2                  PIC X(02) VALUE SPACE.
+       01  WS-DUMMY                 PIC X(15).
+       01  WS-POINTER               PIC 99.
+       PROCEDURE       DIVISION.
+           MOVE 1 TO WS-POINTER.
+      *
+           PERFORM 0001-SUB.
+           IF WS-DUMMY NOT = SPACE
+              DISPLAY "Expected space - Got " WS-DUMMY
+              END-DISPLAY
+           END-IF.
+           IF WS-POINTER NOT = 5
+              DISPLAY "Expected 5 - Got " WS-POINTER
+              END-DISPLAY
+           END-IF.
+      *
+           PERFORM 0001-SUB.
+           IF WS-DUMMY NOT = "ABC AND DE"
+              DISPLAY "Expected ABC AND DE - Got " WS-DUMMY
+              END-DISPLAY
+           END-IF.
+           IF WS-POINTER NOT = 21
+              DISPLAY "Expected 21 - Got " WS-POINTER
+              END-DISPLAY
+           END-IF.
+      *
+           PERFORM 0001-SUB.
+           IF WS-DUMMY NOT = " FG AND HIJ"
+              DISPLAY "Expected  FG AND HIJ - Got " WS-DUMMY
+              END-DISPLAY
+           END-IF.
+           IF WS-POINTER NOT = 40
+              DISPLAY "Expected 40 - Got " WS-POINTER
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+       0001-SUB.
+           UNSTRING WS-RECORD
+                    DELIMITED BY ALL SPACE-2
+              INTO WS-DUMMY
+              POINTER WS-POINTER
+           END-UNSTRING.
+
diff --git a/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_POINTER.cob b/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_POINTER.cob

new file mode 100644 (file)

index 0000000..5d3fdf2
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_POINTER.cob
@@ -0,0 +1,45 @@
+       *> { dg-do run }
+
+       IDENTIFICATION  DIVISION.
+       PROGRAM-ID.     prog.
+       ENVIRONMENT     DIVISION.
+       DATA            DIVISION.
+       WORKING-STORAGE SECTION.
+       01  WS-LAY-RECORD            PIC X(66).
+       01  WS-DUMMY                 PIC X(50).
+       01  WS-KEYWORD               PIC X(32).
+       01  WS-POINTER               PIC 99.
+       PROCEDURE       DIVISION.
+           MOVE
+       '        10  AF-RECORD-TYPE-SEQUENCE-04     PIC   9(05) COMP-3.'
+                  TO WS-LAY-RECORD.
+           MOVE 1 TO WS-POINTER.
+           PERFORM 0001-SUB.
+           IF WS-POINTER NOT = 48
+              DISPLAY "Expected 48 - Got " WS-POINTER
+              END-DISPLAY
+           END-IF.
+           ADD 7  TO WS-POINTER
+           END-ADD.
+           PERFORM 0001-SUB.
+           IF WS-POINTER NOT = 62
+              DISPLAY "Expected 62 - Got " WS-POINTER
+              END-DISPLAY
+           END-IF.
+           PERFORM 0001-SUB.
+           IF WS-POINTER NOT = 63
+              DISPLAY "Expected 63 - Got " WS-POINTER
+              END-DISPLAY
+           END-IF.
+           STOP RUN.
+       0001-SUB.
+           UNSTRING WS-LAY-RECORD
+                    DELIMITED
+                    BY ' PIC '
+                    OR ' COMP-3'
+                    OR '.'
+              INTO WS-DUMMY
+              DELIMITER WS-KEYWORD
+              POINTER WS-POINTER
+           END-UNSTRING.
+
diff --git a/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITER_IN.cob b/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITER_IN.cob

new file mode 100644 (file)

index 0000000..714dba1
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITER_IN.cob
@@ -0,0 +1,35 @@
+       *> { dg-do run }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       ENVIRONMENT      DIVISION.
+       DATA             DIVISION.
+       WORKING-STORAGE SECTION.
+       01  WK-CMD       PIC X(8) VALUE "WWADDBCC".
+       01  WK-SIGNS     PIC XX   VALUE "AB".
+       01  WKS REDEFINES WK-SIGNS.
+           03 WK-SIGN   PIC X OCCURS 2.
+       01  .
+         02 WK-DELIM     PIC X OCCURS 2.
+       01  .
+         02 WK-DATA      PIC X(2) OCCURS 3.
+       PROCEDURE        DIVISION.
+           UNSTRING WK-CMD DELIMITED BY WK-SIGN(1) OR WK-SIGN(2)
+           INTO WK-DATA(1) DELIMITER IN WK-DELIM(1)
+                WK-DATA(2) DELIMITER IN WK-DELIM(2)
+                WK-DATA(3)
+           END-UNSTRING
+           IF  WK-DATA(1)   NOT = "WW"
+            OR WK-DATA(2)   NOT = "DD"
+            OR WK-DATA(3)   NOT = "CC"
+            OR WK-DELIM(1)  NOT = "A"
+            OR WK-DELIM(2)  NOT = "B"
+               DISPLAY """" WK-DATA(1)
+                       WK-DATA(2)
+                       WK-DATA(3)
+                       WK-DELIM(1)
+                       WK-DELIM(2) """"
+               END-DISPLAY
+           END-IF.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/UNSTRING_with_FUNCTION___literal.cob b/gcc/testsuite/cobol.dg/group2/UNSTRING_with_FUNCTION___literal.cob

new file mode 100644 (file)

index 0000000..f4c8032
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UNSTRING_with_FUNCTION___literal.cob
@@ -0,0 +1,42 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/UNSTRING_with_FUNCTION___literal.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA  DIVISION.
+       WORKING-STORAGE SECTION.
+       01  FILLER.
+         05  TSTUNS PIC X(479).
+         05  PRM    PIC X(16) OCCURS 4 TIMES.
+       PROCEDURE DIVISION.
+           MOVE "The,Quick,Brown,Fox" TO TSTUNS.
+           UNSTRING TSTUNS DELIMITED BY ','
+              INTO  PRM(1), PRM(2), PRM(3), PRM(4).
+           DISPLAY "PRM(1) is " PRM(1) ":".
+           DISPLAY "PRM(2) is " PRM(2) ":".
+           DISPLAY "PRM(3) is " PRM(3) ":".
+           DISPLAY "PRM(4) is " PRM(4) ":".
+           UNSTRING FUNCTION UPPER-CASE(TSTUNS) DELIMITED BY ','
+              INTO  PRM(1), PRM(2), PRM(3), PRM(4).
+           DISPLAY "Now using UPPER-CASE"
+           DISPLAY "PRM(1) is " PRM(1) ":".
+           DISPLAY "PRM(2) is " PRM(2) ":".
+           DISPLAY "PRM(3) is " PRM(3) ":".
+           DISPLAY "PRM(4) is " PRM(4) ":".
+           UNSTRING "Daddy,was,a,Rolling stone" DELIMITED BY ','
+              INTO  PRM(1), PRM(2), PRM(3), PRM(4).
+           DISPLAY "Now using Literal"
+           DISPLAY "PRM(1) is " PRM(1) ":".
+           DISPLAY "PRM(2) is " PRM(2) ":".
+           DISPLAY "PRM(3) is " PRM(3) ":".
+           DISPLAY "PRM(4) is " PRM(4) ":".
+           UNSTRING FUNCTION LOWER-CASE("Daddy,was,a,Rolling stone")
+                DELIMITED BY ','
+              INTO  PRM(1), PRM(2), PRM(3), PRM(4).
+           DISPLAY "Now using Literal + LOWER-CASE"
+           DISPLAY "PRM(1) is " PRM(1) ":".
+           DISPLAY "PRM(2) is " PRM(2) ":".
+           DISPLAY "PRM(3) is " PRM(3) ":".
+           DISPLAY "PRM(4) is " PRM(4) ":".
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/UNSTRING_with_FUNCTION___literal.out b/gcc/testsuite/cobol.dg/group2/UNSTRING_with_FUNCTION___literal.out

new file mode 100644 (file)

index 0000000..297f254
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/UNSTRING_with_FUNCTION___literal.out
@@ -0,0 +1,20 @@
+PRM(1) is The             :
+PRM(2) is Quick           :
+PRM(3) is Brown           :
+PRM(4) is Fox             :
+Now using UPPER-CASE
+PRM(1) is THE             :
+PRM(2) is QUICK           :
+PRM(3) is BROWN           :
+PRM(4) is FOX             :
+Now using Literal
+PRM(1) is Daddy           :
+PRM(2) is was             :
+PRM(3) is a               :
+PRM(4) is Rolling stone   :
+Now using Literal + LOWER-CASE
+PRM(1) is daddy           :
+PRM(2) is was             :
+PRM(3) is a               :
+PRM(4) is rolling stone   :
+
diff --git a/gcc/testsuite/cobol.dg/group2/_-static__compilation.cob b/gcc/testsuite/cobol.dg/group2/_-static__compilation.cob

new file mode 100644 (file)

index 0000000..7843d3d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/_-static__compilation.cob
@@ -0,0 +1,10 @@
+       *> { dg-do run }
+       *> { dg-options "-static" }
+       *> { dg-output-file "group2/_-static__compilation.out" }
+
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       PROCEDURE DIVISION.
+       DISPLAY "hello, world".
+       end program prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/_-static__compilation.out b/gcc/testsuite/cobol.dg/group2/_-static__compilation.out

new file mode 100644 (file)

index 0000000..ae0e511
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/_-static__compilation.out
@@ -0,0 +1,2 @@
+hello, world
+
diff --git a/gcc/testsuite/cobol.dg/group2/access_to_OPTIONAL_LINKAGE_item_not_passed.cob b/gcc/testsuite/cobol.dg/group2/access_to_OPTIONAL_LINKAGE_item_not_passed.cob

new file mode 100644 (file)

index 0000000..5cf0446
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/access_to_OPTIONAL_LINKAGE_item_not_passed.cob
@@ -0,0 +1,34 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/access_to_OPTIONAL_LINKAGE_item_not_passed.out" }
+
+        identification   division.
+        program-id.      caller.
+        data             division.
+        working-storage  section.
+        01 x             pic x(4) value '9876'.
+        procedure        division.
+           call 'callee' using x
+           end-call
+           call 'callee' using omitted
+           end-call
+           stop run.
+           end program caller.
+
+        identification   division.
+        program-id.      callee.
+        data             division.
+        working-storage  section.
+        01 py pointer.
+        linkage          section.
+        01 x.
+          05 y          pic x(4).
+        procedure        division using optional x.
+        set py to address of x.
+        if py is not equal to zero
+            display y
+        else
+            display "parameter omitted"
+        end-if.
+        goback.
+        end program callee.
+
diff --git a/gcc/testsuite/cobol.dg/group2/access_to_OPTIONAL_LINKAGE_item_not_passed.out b/gcc/testsuite/cobol.dg/group2/access_to_OPTIONAL_LINKAGE_item_not_passed.out

new file mode 100644 (file)

index 0000000..9e82a04
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/access_to_OPTIONAL_LINKAGE_item_not_passed.out
@@ -0,0 +1,3 @@
+9876
+parameter omitted
+
author	Robert Dubner <rdubner@symas.com>
	Sun, 11 May 2025 13:40:41 +0000 (09:40 -0400)
committer	Robert Dubner <rdubner@symas.com>
	Tue, 29 Jul 2025 16:06:38 +0000 (12:06 -0400)
gcc/testsuite/cobol.dg/group2/258_Nested_PERFORM.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/258_Nested_PERFORM.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/259_PERFORM_VARYING_BY_-0.2.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/259_PERFORM_VARYING_BY_-0.2.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/338_Default_Arithmetic__1_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/338_Default_Arithmetic__1_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ALLOCATE_Rule_8_OPTION_INITIALIZE_with_figconst.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ALLOCATE_Rule_8_OPTION_INITIALIZE_with_figconst.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_basic_default_versions.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_basic_default_versions.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_with_BASED_item__1_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ALLOCATE___FREE_with_BASED_item__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ANY_LENGTH__1_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ANY_LENGTH__1_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ANY_LENGTH__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ANY_LENGTH__2_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ANY_LENGTH__3_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ANY_LENGTH__3_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ANY_LENGTH__4_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ANY_LENGTH__5_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/ANY_LENGTH__5_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Alphanumeric_MOVE_with_truncation.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Alphanumeric_MOVE_with_truncation.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Alphanumeric_and_binary_numeric.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/CALL_with_OMITTED_parameter.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/CALL_with_OMITTED_parameter.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/CONTINUE_AFTER_1_SECONDS.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/CONTINUE_AFTER_1_SECONDS.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/CURRENCY_SIGN_WITH_PICTURE_SYMBOL.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Class_check_with_reference_modification.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Complex_HEX__VALUE_and_MOVE.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Complex_IF.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Complex_IF.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Concatenation_operator.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Concatenation_operator.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__1_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__1_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__2_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__3_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__3_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__4_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__4_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__5_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/DECIMAL-POINT_is_COMMA__5_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/EC-SIZE-TRUNCATION_EC-SIZE-OVERFLOW.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/EC-SIZE-TRUNCATION_EC-SIZE-OVERFLOW.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/EC-SIZE-ZERO-DIVIDE__fixed_and_float.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/EC-SIZE-ZERO-DIVIDE__fixed_and_float.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/EXIT_PARAGRAPH.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/EXIT_PERFORM.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/EXIT_PERFORM.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/EXIT_PERFORM_CYCLE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/EXIT_PERFORM_CYCLE.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/EXIT_SECTION.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FLOAT-LONG_with_SIZE_ERROR.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FLOAT-LONG_with_SIZE_ERROR.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FLOAT-SHORT___FLOAT-LONG_w_o_SIZE_ERROR.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FLOAT-SHORT___FLOAT-LONG_w_o_SIZE_ERROR.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FLOAT-SHORT_with_SIZE_ERROR.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/FLOAT-SHORT_with_SIZE_ERROR.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Fixed_continuation_indicator.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Fixed_continuation_indicator.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Index_and_parenthesized_expression.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Index_and_parenthesized_expression.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/LENGTH_OF_omnibus.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/LENGTH_OF_omnibus.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__3__with_recursive_PROGRAM-ID.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__3__with_recursive_PROGRAM-ID.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__4__with_recursive_PROGRAM-ID_..._USING.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/LOCAL-STORAGE__4__with_recursive_PROGRAM-ID_..._USING.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_Z_literal_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_Z_literal_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_indexes.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_integer_literal_to_alphanumeric.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_integer_literal_to_alphanumeric.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_to_JUSTIFIED_item.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_to_JUSTIFIED_item.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__1_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__1_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_to_edited_item__2_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_to_item_with_simple_and_floating_insertion.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_to_item_with_simple_and_floating_insertion.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_to_itself.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_with_group_refmod.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_with_refmod.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/MOVE_with_refmod__variable_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Multi-target_MOVE_with_subscript_re-evaluation.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Multi-target_MOVE_with_subscript_re-evaluation.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__1_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__1_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Non-numeric_data_in_numeric_items__2_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Non-overflow_after_overflow.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/OCCURS_clause_with_1_entry.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/OSVS_Arithmetic_Test__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/OSVS_Arithmetic_Test__2_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/PERFORM_..._CONTINUE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/PERFORM_inline__1_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/PERFORM_inline__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/PERFORM_type_OSVS.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/PIC_ZZZ-__ZZZ_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Quick_check_of_PIC_XX_COMP-5.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Quick_check_of_PIC_XX_COMP-5.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Quote_marks_in_comment_paragraphs.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Quote_marks_in_comment_paragraphs.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/REDEFINES_values_on_FILLER_and_INITIALIZE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/REDEFINES_values_on_FILLER_and_INITIALIZE.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Recursive_PERFORM_paragraph.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Recursive_PERFORM_paragraph.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/SORT__EBCDIC_table_sort__1_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/SORT__EBCDIC_table_sort__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/SORT__table_sort.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/SORT__table_sort__2_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/SORT__table_sort__2_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/SORT__table_sort__3A_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/SORT__table_sort__3A_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/SORT__table_sort__3B_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/SORT__table_sort__3B_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/SOURCE_FIXED_FREE_directives.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/SOURCE_FIXED_FREE_directives.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/STOP_RUN_WITH_ERROR_STATUS.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/STOP_RUN_WITH_NORMAL_STATUS.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/STRING___UNSTRING__NOT__ON_OVERFLOW.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/STRING___UNSTRING__NOT__ON_OVERFLOW.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/STRING_with_subscript_reference.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Static_CALL_with_ON_EXCEPTION__with_-fno-static-call_.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/Static_CALL_with_ON_EXCEPTION__with_-fno-static-call_.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_ALL_LOW-VALUE.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_ALL_SPACE-2.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITED_POINTER.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UNSTRING_DELIMITER_IN.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UNSTRING_with_FUNCTION___literal.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/UNSTRING_with_FUNCTION___literal.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/_-static__compilation.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/_-static__compilation.out	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/access_to_OPTIONAL_LINKAGE_item_not_passed.cob	[new file with mode: 0644]	patch \| blob
gcc/testsuite/cobol.dg/group2/access_to_OPTIONAL_LINKAGE_item_not_passed.out	[new file with mode: 0644]	patch \| blob