diff --git a/gcc/cobol/UAT/failsuite.src/run_evaluate.at b/gcc/cobol/UAT/failsuite.src/run_evaluate.at
index 90d5af41347c1e4154f92b630ed78094b286c521..f5d35b3bfd5bb742f1ed0c7d168bebd2755a4f98 100644
--- a/gcc/cobol/UAT/failsuite.src/run_evaluate.at
+++ b/gcc/cobol/UAT/failsuite.src/run_evaluate.at
@@ -8,50 +8,3 @@ AT_COLOR_TESTS
AT_TESTED('$GCOBOL')
-AT_SETUP([EVALUATE condition (2)])
-AT_KEYWORDS([evaluate condition])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 XVAL PIC X VALUE '_'.
- 88 UNDERSCORE VALUE '_'.
- PROCEDURE DIVISION.
- DISPLAY 'Next line should be "UNDERSCORE evaluates to TRUE"'
- EVALUATE TRUE
- WHEN NOT UNDERSCORE
- DISPLAY
- "***IMPROPERLY*** NOT UNDERSCORE evaluates to TRUE"
- END-DISPLAY
- END-EVALUATE.
- EVALUATE TRUE
- WHEN UNDERSCORE
- DISPLAY "UNDERSCORE evaluates to TRUE"
- END-DISPLAY
- END-EVALUATE.
-
- DISPLAY
- 'Next line should be "NOT UNDERSCORE evaluates to FALSE"'
- EVALUATE FALSE
- WHEN NOT UNDERSCORE
- DISPLAY "NOT UNDERSCORE evaluates to FALSE"
- END-DISPLAY
- END-EVALUATE.
- EVALUATE FALSE
- WHEN UNDERSCORE
- DISPLAY
- "***IMPROPERLY*** UNDERSCORE evaluates to FALSE"
- END-DISPLAY
- END-EVALUATE.
- STOP RUN.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([./a.out], [0], [Next line should be "UNDERSCORE evaluates to TRUE"
-UNDERSCORE evaluates to TRUE
-Next line should be "NOT UNDERSCORE evaluates to FALSE"
-NOT UNDERSCORE evaluates to FALSE
-], [])
-AT_CLEANUP
-
-
diff --git a/gcc/cobol/UAT/failsuite.src/run_functions.at b/gcc/cobol/UAT/failsuite.src/run_functions.at
index 68fc377f768ba3ca01729276b3cf95995e36dce8..9760fd5b601eb9c5234540c86b6ecb47ccca04c9 100644
--- a/gcc/cobol/UAT/failsuite.src/run_functions.at
+++ b/gcc/cobol/UAT/failsuite.src/run_functions.at
@@ -672,50 +672,6 @@ AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
AT_CLEANUP
-
-AT_SETUP([UDF in COMPUTE])
-AT_KEYWORDS([functions])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- FUNCTION-ID. func.
-
- DATA DIVISION.
- LINKAGE SECTION.
- 01 num PIC 999.
-
- PROCEDURE DIVISION RETURNING num.
- MOVE 100 TO num
- .
- END FUNCTION func.
-
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
-
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- REPOSITORY.
- FUNCTION func.
-
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 x PIC 999.
-
- PROCEDURE DIVISION.
- COMPUTE x = 101 + FUNCTION func
- DISPLAY x
- .
- END PROGRAM prog.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[201
-])
-
-AT_CLEANUP
-
-
AT_SETUP([UDF replacing intrinsic function])
AT_KEYWORDS([functions SUBSTITUTE])
AT_DATA([prog.cob], [
@@ -756,65 +712,6 @@ AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
AT_CLEANUP
-AT_SETUP([UDF with recursion])
-AT_KEYWORDS([functions LOCAL-STORAGE])
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- FUNCTION-ID. foo.
-
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 ttl PIC 9 VALUE 1.
-
- LOCAL-STORAGE SECTION.
- 01 num PIC 9.
-
- LINKAGE SECTION.
- 01 arg PIC 9.
- 01 ret PIC 9.
-
- PROCEDURE DIVISION USING arg RETURNING ret.
- IF arg < 5
- ADD 1 TO arg GIVING num END-ADD
- MOVE FUNCTION foo (num) TO ret
- ELSE
- MOVE arg TO ret
- END-IF
- DISPLAY "Step: " ttl ", Arg: " arg ", Return: " ret
- END-DISPLAY
- ADD 1 to ttl END-ADD
- GOBACK.
- END FUNCTION foo.
-
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
-
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- REPOSITORY.
- FUNCTION foo.
-
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 num PIC 9 VALUE 1.
-
- PROCEDURE DIVISION.
- DISPLAY "Return value '" FUNCTION foo (num) "'"
- WITH NO ADVANCING
- END-DISPLAY
- GOBACK.
- END PROGRAM prog.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
-[Step: 1, Arg: 5, Return: 5
-Step: 2, Arg: 4, Return: 5
-Step: 3, Arg: 3, Return: 5
-Step: 4, Arg: 2, Return: 5
-Step: 5, Arg: 1, Return: 5
-Return value '5'], [])
-AT_CLEANUP
-
AT_SETUP([v2-bugs functions repository])
AT_KEYWORDS([v1-bugs functions repository])
# REPOSITORY FUNCTION clause
diff --git a/gcc/cobol/UAT/failsuite.src/run_subscripts.at b/gcc/cobol/UAT/failsuite.src/run_subscripts.at
index e0658c774b7d0f95753eae110f7497f1afd4f3d7..d217feb8dc095e2ca058536d7b5bb51423b741aa 100644
--- a/gcc/cobol/UAT/failsuite.src/run_subscripts.at
+++ b/gcc/cobol/UAT/failsuite.src/run_subscripts.at
@@ -23,39 +23,3 @@
## 8.4.1.2.3 General rules
-AT_SETUP([383 SSRANGE and NOSSRANGE directives])
-AT_SKIP_IF([test "$COB_DIALECT" != "gnu"])
-AT_KEYWORDS([runsubscripts subscripts extensions directive])
-
-# WARNING: this testcase is "broken" as those SSRANGE may only be
-# defined before IDENTIFICATION DIVISION (iniatial $SET)
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
-
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 x.
- 03 y PIC X OCCURS 5 TIMES VALUE SPACE.
- 03 z PIC X VALUE "!".
- 01 idx PIC 99 VALUE 6.
-
- PROCEDURE DIVISION.
- $SET NOSSRANGE
- DISPLAY y (idx)
- *> Note: MF says "sets BOUND"
- $SET SSRANGE
- DISPLAY y (idx)
- .
-])
-
-AT_CHECK([$COMPILE -DTEST-SUBSCRIPT prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [1],
-[!
-], [libcob: prog.cob:17: error: subscript of 'y' out of bounds: 6
-note: maximum subscript for 'y': 5
-])
-
-AT_CLEANUP
-
\ No newline at end of file
diff --git a/gcc/cobol/UAT/failsuite.src/syn_copy.at b/gcc/cobol/UAT/failsuite.src/syn_copy.at
index 24518b765f6ed9919c7e892a395b1ee2b2ae3dec..abfdd8fa3d590bc6dff65f9ef2ee2fb177b9d6af 100644
--- a/gcc/cobol/UAT/failsuite.src/syn_copy.at
+++ b/gcc/cobol/UAT/failsuite.src/syn_copy.at
@@ -21,48 +21,3 @@
### COBOL for GCC Test Suite - testsuite adapted by Marty Heyman
## Copyright (C) 2022-23 COBOLworx, a subsidiary of Symas Corp.
-AT_SETUP([392 COPY: IN / OF / -I: 3])
-AT_KEYWORDS([copy cobc])
-AT_SKIP_IF([test "$COB_DIALECT" != "gnu"])
-# TODO: Should default to auto-folding when IN "sub2" (literal) is
-# used and therefore don't work on case-sensitive file-systems
-#
-# jkl: This test is invalid. "The implementor shall define the
-# rules for locating the library text referenced by text-name-1
-# or literal-1. When neither library-name-1 nor literal-2 is
-# specified, a default COBOL library is used. The implementor
-# defines the mechanism for identifying the default COBOL
-# library."
-#
-# This implementation consults the environment. If an environment
-# variable is defined for the library or copybook name, the value of
-# that variable is used. If not, the name from the Cobol text is
-# used. If a literal is supplied instead of a user-defined Cobol
-# word, no change is made to the name; it either exists, literally, or
-# it does not. If a user-defined Cobol word is supplied, the name is
-# tried with various suffixes (and without) using glob(3) to match.
-#
-# In no event is either name transformed to upper case. Perhaps that
-# should be a future option, but I suggest waiting for real-world
-# examples and a willing customer.
-#
-AT_DATA([prog3.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- COPY "copy.inc" IN sub2.
- PROCEDURE DIVISION.
- DISPLAY TEST-VAR.
- STOP RUN.
-])
-AT_CHECK([mkdir -p SUB/UNDER], [0], [], [])
-AT_DATA([SUB/UNDER/copy.inc], [
- 77 TEST-VAR PIC X VALUE '3'.
-])
-AT_DATA([copy.inc], [
- 77 TEST-VAR PIC X VALUE '4'.
-])
-AT_CHECK([$COMPILE_ONLY prog3.cob], [0], [], [])
-AT_CLEANUP
-
diff --git a/gcc/cobol/UAT/failsuite.src/syn_definition.at b/gcc/cobol/UAT/failsuite.src/syn_definition.at
index 3a8100269485fd038340db3103adaf8c23fbdea0..dc5188d7c9e2f934fcd5c5473778cf8482bfd0bb 100644
--- a/gcc/cobol/UAT/failsuite.src/syn_definition.at
+++ b/gcc/cobol/UAT/failsuite.src/syn_definition.at
@@ -223,28 +223,3 @@ AT_CHECK([$COMPILE_ONLY prog.cob], [0], [],
])
AT_CLEANUP
-AT_SETUP([ALPHABET definition])
-AT_KEYWORDS([definition])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- SPECIAL-NAMES.
- ALPHABET TESTME IS
- 'A' THROUGH 'Z', x'00' thru x'05';
- x'41' ALSO x'42', ALSO x'00', x'C1' ALSO x'C2'.
- ALPHABET FINE
- 'A' also 'B' also 'C' also 'd' also 'e' ALSO 'f',
- 'g' also 'G', '1' thru '9', x'00'.
-])
-
-AT_CHECK([$COMPILE_ONLY prog.cob], [1], [],
-[prog.cob:9: error: ALPHABET , character 'A' (x'41') in position 32 already defined at position 0 at 'ALSO'
-prog.cob:10: 1 errors in DATA DIVISION, compilation ceases at 'ALPHABET'
-cobol1: error: failed compiling prog.cob
-])
-AT_CLEANUP
-
-
diff --git a/gcc/cobol/UAT/failsuite.src/syn_misc.at b/gcc/cobol/UAT/failsuite.src/syn_misc.at
index 1cb7ccf94ea82a2eefc95449a1294fab25bdf1ed..9c4e1cd40b66be8af979fa6e2c7593ba5146f12c 100644
--- a/gcc/cobol/UAT/failsuite.src/syn_misc.at
+++ b/gcc/cobol/UAT/failsuite.src/syn_misc.at
@@ -98,3 +98,22 @@ AT_CHECK([$COMPILE prog.cob], [0], [], [])
AT_CHECK([./a.out], [0], [], [])
AT_CLEANUP
+AT_SETUP([X literals])
+AT_KEYWORDS([misc])
+# TODO - Needs better error messages
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ PROCEDURE DIVISION.
+ *> Valid form
+ DISPLAY X"0123456789ABCDEF"
+
+ *> invalid form
+ DISPLAY X"GH"
+ X"1"
+ END-DISPLAY.
+])
+AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], [])
+AT_CLEANUP
+
+
diff --git a/gcc/cobol/UAT/skipsuite.src/run_fundamental.at b/gcc/cobol/UAT/skipsuite.src/run_fundamental.at
index c3a46a12e195ddfac6c4d9e5a57cd4530a60c1b0..ec7563a660e7da69ccb3998441e5016a8324dc97 100644
--- a/gcc/cobol/UAT/skipsuite.src/run_fundamental.at
+++ b/gcc/cobol/UAT/skipsuite.src/run_fundamental.at
@@ -441,31 +441,6 @@ AT_CHECK([./a.out], [0],
])
AT_CLEANUP
-
-AT_SETUP([Context sensitive words (5)])
-AT_KEYWORDS([fundamental recursive])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-# TODO NOT IMPLEMENTED "RECURSIVE"
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog RECURSIVE.
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 RECURSIVE PIC 9 VALUE 0.
- PROCEDURE DIVISION.
- DISPLAY RECURSIVE NO ADVANCING
- END-DISPLAY.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([./a.out], [0], [0], [])
-AT_CLEANUP
-
AT_SETUP([SYNC in OCCURS])
AT_KEYWORDS([fundamental CDF SYNCHRONIZE])
AT_SKIP_IF(false)
diff --git a/gcc/cobol/UAT/skipsuite.src/run_misc.at b/gcc/cobol/UAT/skipsuite.src/run_misc.at
index 4066cdc881803579181f36ca9e07261fbbd027ee..1b7505cfad0bbfa675f71097eb26955778ea70a7 100644
--- a/gcc/cobol/UAT/skipsuite.src/run_misc.at
+++ b/gcc/cobol/UAT/skipsuite.src/run_misc.at
@@ -235,158 +235,8 @@ AT_CHECK([$COBCRUN_DIRECT ./a.out3], [0], [], [])
AT_CLEANUP
-AT_SETUP([240. Recursive CALL of RECURSIVE program])
-AT_KEYWORDS([misc CANCEL EXTERNAL])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-AT_DATA([caller.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. caller IS RECURSIVE.
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 77 STOPPER PIC S9 EXTERNAL.
- PROCEDURE DIVISION.
- MOVE 0 TO STOPPER
- CALL "callee"
- DISPLAY 'OK' NO ADVANCING END-DISPLAY
- *> FIXME: CANCEL broken on special environments
- *> CANCEL "callee" , "callee2"
- DISPLAY ' + FINE' NO ADVANCING END-DISPLAY
- STOP RUN.
-])
-AT_DATA([callee.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. callee IS RECURSIVE.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 77 STOPPER PIC S9 EXTERNAL.
- PROCEDURE DIVISION.
- IF STOPPER = 9
- MOVE -1 TO STOPPER
- ELSE
- ADD 1 TO STOPPER
- CALL "callee2"
- END-IF
- GOBACK.
-])
-AT_DATA([callee2.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. callee2 IS RECURSIVE.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 77 STOPPER PIC S9 EXTERNAL.
- PROCEDURE DIVISION.
- IF STOPPER NOT EQUAL -1
- CALL "callee"
- END-IF
- GOBACK.
-])
-
-AT_CHECK([$COMPILE -c callee.cob], [0], [], [])
-AT_CHECK([$COMPILE -c callee2.cob], [0], [], [])
-AT_CHECK([$COMPILE -o caller caller.cob callee.o callee2.o], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [OK + FINE], [])
-AT_CLEANUP
-
-
-AT_SETUP([241. Recursive CALL of INITIAL program])
-AT_KEYWORDS([misc])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-AT_DATA([caller.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. caller.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 77 STOPPER PIC 9 EXTERNAL.
- PROCEDURE DIVISION.
- MOVE 0 TO STOPPER
- CALL "callee" END-CALL.
- GOBACK.
-])
-AT_DATA([callee.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. callee IS INITIAL.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 77 STOPPER PIC 9 EXTERNAL.
- PROCEDURE DIVISION.
- IF STOPPER = 1
- DISPLAY 'INITIAL prog was called RECURSIVE'
- END-DISPLAY
- * Following statement not ISO, corrected below
- * STOP RUN RETURNING 1
- MOVE 1 TO RETURN-CODE
- STOP RUN
- ELSE
- MOVE 1 TO STOPPER
- CALL "callee2" END-CALL
- END-IF.
- GOBACK.
-])
-AT_DATA([callee2.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. callee2.
- PROCEDURE DIVISION.
- CALL "callee" END-CALL.
- GOBACK.
-])
-AT_CHECK([$COMPILE -c callee.cob], [0], [], [])
-AT_CHECK([$COMPILE -c callee2.cob], [0], [], [])
-AT_CHECK([$COMPILE -o caller caller.cob callee.o callee2.o], [0], [], [])
-AT_CHECK([./caller], [1], [INITIAL prog was called RECURSIVE
-], [])
-AT_CLEANUP
-
-
-AT_SETUP([Recursive CALL with RECURSIVE assumed])
-AT_KEYWORDS([misc])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-AT_DATA([caller.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. caller.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 77 STOPPER PIC 9 EXTERNAL.
- PROCEDURE DIVISION.
- MOVE 0 TO STOPPER
- CALL "callee" END-CALL.
- GOBACK.
-])
-AT_DATA([callee.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. callee IS INITIAL.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 77 STOPPER PIC 9 EXTERNAL.
- PROCEDURE DIVISION.
- IF STOPPER = 8
- DISPLAY 'OK' NO ADVANCING END-DISPLAY.
- IF STOPPER NOT = 9
- ADD 1 TO STOPPER END-ADD
- CALL "callee2" END-CALL.
- GOBACK.
-])
-AT_DATA([callee2.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. callee2.
- PROCEDURE DIVISION.
- CALL "callee" END-CALL.
- GOBACK.
-])
-AT_CHECK([$COMPILE -c callee.cob], [0], [], [])
-AT_CHECK([$COMPILE -c callee2.cob], [0], [], [])
-AT_CHECK([$COMPILE -o caller caller.cob callee.o callee2.o], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [OK], [])
-AT_CLEANUP
-
-
AT_SETUP([Recursive CALL with ON EXCEPTION])
AT_KEYWORDS([misc EXCEPTION-STATUS])
-AT_SKIP_IF(false)
AT_XFAIL_IF(true)
AT_DATA([caller.cob], [
IDENTIFICATION DIVISION.
@@ -440,7 +290,6 @@ AT_CLEANUP
AT_SETUP([Multiple calls of INITIAL program])
AT_KEYWORDS([misc CALL])
-AT_SKIP_IF(false)
AT_XFAIL_IF(true)
AT_DATA([caller.cob], [
IDENTIFICATION DIVISION.
@@ -820,181 +669,6 @@ AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
AT_CLEANUP
-AT_SETUP([PERFORM inline (1)])
-AT_KEYWORDS([misc])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-AT_DATA([prog.cob], [
- 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
- .
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([PERFORM inline (2)])
-AT_KEYWORDS([misc])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-AT_DATA([prog.cob], [
- 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
- .
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([UNSTRING DELIMITER IN])
-AT_KEYWORDS([misc])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-AT_DATA([prog.cob], [
- 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.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([PERFORM type OSVS])
-AT_KEYWORDS([misc])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-AT_DATA([prog.cob], [
- 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.
-])
-AT_CHECK([$COMPILE prog.cob], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
-AT_CLEANUP
-
-
-AT_SETUP([Sticky LINKAGE])
-AT_KEYWORDS([misc])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-AT_DATA([callee.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. callee.
- DATA DIVISION.
- LINKAGE SECTION.
- 01 P1 PIC X.
- 01 P2 PIC X(6).
- 01 P3 PIC X(6).
- PROCEDURE DIVISION USING P1 P2.
- IF P1 = "A"
- SET ADDRESS OF P3 TO ADDRESS OF P2
- ELSE
- IF P3 NOT = "OKOKOK"
- DISPLAY P3
- END-DISPLAY
- END-IF
- END-IF.
- EXIT PROGRAM.
-])
-AT_DATA([caller.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. caller.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 P1 PIC X VALUE "A".
- 01 P2 PIC X(6) VALUE "NOT OK".
- PROCEDURE DIVISION.
- CALL "callee" USING P1 P2
- END-CALL.
- MOVE "B" TO P1.
- MOVE "OKOKOK" TO P2.
- CALL "callee" USING P1
- END-CALL.
- STOP RUN.
-])
-AT_CHECK([$COMPILE -c callee.cob], [0], [], [])
-AT_CHECK([$COMPILE -o caller caller.cob callee.o], [0], [], [])
-AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], [])
-AT_CLEANUP
AT_SETUP([COB_PRE_LOAD with entry points])
diff --git a/gcc/cobol/UAT/skipsuite.src/run_subscripts.at b/gcc/cobol/UAT/skipsuite.src/run_subscripts.at
index 6a7563469323acafd129b492314ee6f4637fcdd6..b9166cde6e4b1609d7c30bd822c02afb94ecc438 100644
--- a/gcc/cobol/UAT/skipsuite.src/run_subscripts.at
+++ b/gcc/cobol/UAT/skipsuite.src/run_subscripts.at
@@ -194,7 +194,37 @@ note: maximum subscript for 'y': 5
])
AT_CHECK([$COBCRUN_DIRECT ./a.outn], [0], [!], [])
AT_CHECK([$COBCRUN_DIRECT ./a.outn2], [0], [!], [])
-
AT_CLEANUP
+AT_SETUP([SSRANGE/NOSSRANGE directives (IBM, not ISO)])
+AT_KEYWORDS([runsubscripts subscripts extensions directive])
+AT_XFAIL_IF(true)
+# WARNING: this testcase is "broken" as those SSRANGE may only be
+# defined before IDENTIFICATION DIVISION (iniatial $SET)
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 x.
+ 03 y PIC X OCCURS 5 TIMES VALUE SPACE.
+ 03 z PIC X VALUE "!".
+ 01 idx PIC 99 VALUE 6.
+
+ PROCEDURE DIVISION.
+ $SET NOSSRANGE
+ DISPLAY y (idx)
+ *> Note: MF says "sets BOUND"
+ $SET SSRANGE
+ DISPLAY y (idx)
+ .
+])
+AT_CHECK([$COMPILE -DTEST-SUBSCRIPT prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [1],
+[!
+], [libcob: prog.cob:17: error: subscript of 'y' out of bounds: 6
+note: maximum subscript for 'y': 5
+])
+AT_CLEANUP
diff --git a/gcc/cobol/UAT/skipsuite.src/syn_copy.at b/gcc/cobol/UAT/skipsuite.src/syn_copy.at
index 891607bdf31b3630f6830de2964ef8ce787cc656..ffc89c97356233e0ec4a829d58d7c24dd5250758 100644
--- a/gcc/cobol/UAT/skipsuite.src/syn_copy.at
+++ b/gcc/cobol/UAT/skipsuite.src/syn_copy.at
@@ -481,3 +481,48 @@ AT_CHECK([./prog], [0], [OK], [])
AT_CLEANUP
+AT_SETUP([392 COPY: IN / OF / -I: 3])
+AT_KEYWORDS([copy cobc])
+AT_XFAIL_IF(true)
+# TODO: Should default to auto-folding when IN "sub2" (literal) is
+# used and therefore don't work on case-sensitive file-systems
+#
+# jkl: This test is invalid. "The implementor shall define the
+# rules for locating the library text referenced by text-name-1
+# or literal-1. When neither library-name-1 nor literal-2 is
+# specified, a default COBOL library is used. The implementor
+# defines the mechanism for identifying the default COBOL
+# library."
+#
+# This implementation consults the environment. If an environment
+# variable is defined for the library or copybook name, the value of
+# that variable is used. If not, the name from the Cobol text is
+# used. If a literal is supplied instead of a user-defined Cobol
+# word, no change is made to the name; it either exists, literally, or
+# it does not. If a user-defined Cobol word is supplied, the name is
+# tried with various suffixes (and without) using glob(3) to match.
+#
+# In no event is either name transformed to upper case. Perhaps that
+# should be a future option, but I suggest waiting for real-world
+# examples and a willing customer.
+#
+AT_DATA([prog3.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ COPY "copy.inc" IN sub2.
+ PROCEDURE DIVISION.
+ DISPLAY TEST-VAR.
+ STOP RUN.
+])
+AT_CHECK([mkdir -p SUB/UNDER], [0], [], [])
+AT_DATA([SUB/UNDER/copy.inc], [
+ 77 TEST-VAR PIC X VALUE '3'.
+])
+AT_DATA([copy.inc], [
+ 77 TEST-VAR PIC X VALUE '4'.
+])
+AT_CHECK([$COMPILE_ONLY prog3.cob], [0], [], [])
+AT_CLEANUP
+
diff --git a/gcc/cobol/UAT/skipsuite.src/syn_definition.at b/gcc/cobol/UAT/skipsuite.src/syn_definition.at
index 742409a929f32857892441cefc19b15bb07f9c83..1037a93d2935b0c3d383ef1a37ff91785df5c62e 100644
--- a/gcc/cobol/UAT/skipsuite.src/syn_definition.at
+++ b/gcc/cobol/UAT/skipsuite.src/syn_definition.at
@@ -38,34 +38,7 @@ AT_CHECK([$COMPILE_ONLY prog.cob], [1], [],
AT_CLEANUP
-AT_SETUP([405 INITIAL / RECURSIVE before COMMON])
-AT_KEYWORDS([PROGRAM-ID definition])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-# RECURSIVE not implemented.
-
-AT_DATA([containing-prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. containing-prog.
-
- PROCEDURE DIVISION.
-
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog-1 IS INITIAL COMMON.
- PROCEDURE DIVISION.
- STOP RUN.
- END PROGRAM prog-1.
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog-2 IS RECURSIVE COMMON.
- PROCEDURE DIVISION.
- STOP RUN.
- END PROGRAM prog-2.
-])
-
-AT_CHECK([$COMPILE_ONLY containing-prog.cob], [0], [], [])
-
-AT_CLEANUP
AT_SETUP([406 Undefined data name])
diff --git a/gcc/cobol/UAT/skipsuite.src/syn_misc.at b/gcc/cobol/UAT/skipsuite.src/syn_misc.at
index 44eb8d06c3453583193f02f0592d7d7ff466a45e..7613b1b7b2fea7f092a7496cfb18221a4883c728 100644
--- a/gcc/cobol/UAT/skipsuite.src/syn_misc.at
+++ b/gcc/cobol/UAT/skipsuite.src/syn_misc.at
@@ -2533,36 +2533,6 @@ prog3.cob:26: error: syntax error, unexpected +
AT_CLEANUP
-AT_SETUP([X literals])
-AT_KEYWORDS([misc])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-# TODO - NOT IMPLEMENTED - diagnostic messages
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- PROCEDURE DIVISION.
- *> Valid form
- DISPLAY X"0123456789ABCDEF"
-
- *> invalid form
- DISPLAY X"GH"
- X"1"
- END-DISPLAY.
-])
-
-AT_CHECK([$COMPILE_ONLY prog.cob], [1], [],
-[prog.cob:9: error: invalid X literal: 'GH'
-prog.cob:9: error: literal contains invalid character 'G'
-prog.cob:9: error: literal contains invalid character 'H'
-prog.cob:10: error: invalid X literal: '1'
-prog.cob:10: error: literal does not have an even number of digits
-])
-
-AT_CLEANUP
-
-
AT_SETUP([national literals])
AT_KEYWORDS([misc])
AT_SKIP_IF(false)
@@ -2768,30 +2738,6 @@ AT_CHECK([$COMPILE_ONLY -fnot-reserved=DISPLAY -freserved=COMP-1=DISPLAY prog2.c
AT_CLEANUP
-AT_SETUP([swapped SOURCE- and OBJECT-COMPUTER])
-AT_KEYWORDS([misc extensions])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-# TODO - NOT IMPLEMENTED - Diagnostic messages
-# This is a test for statement order.
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
-
- ENVIRONMENT DIVISION.
- CONFIGURATION SECTION.
- OBJECT-COMPUTER. a.
- SOURCE-COMPUTER. b.
-])
-
-# MF extension, supported by GnuCOBOL
-AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], [])
-# note: testing with lax configuration, otherwise there would be an error
-
-AT_CLEANUP
-
-
AT_SETUP([CONF. SECTION paragraphs in wrong order])
AT_KEYWORDS([misc extensions])
AT_SKIP_IF(false)
diff --git a/gcc/cobol/UAT/skipsuite.src/syn_occurs.at b/gcc/cobol/UAT/skipsuite.src/syn_occurs.at
index 8c4b0d14290e56ab0ab4f45433a3b8229c2438f4..32efee69fadf000ee375106486f44dd000c4cc2b 100644
--- a/gcc/cobol/UAT/skipsuite.src/syn_occurs.at
+++ b/gcc/cobol/UAT/skipsuite.src/syn_occurs.at
@@ -243,32 +243,6 @@ AT_CLEANUP
# 9) DONE
-AT_SETUP([Nested OCCURS clause])
-AT_KEYWORDS([occurs])
-AT_SKIP_IF(false)
-AT_XFAIL_IF(true)
-# NOT IMPLEMENTED: Diagnostic messages
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 G-1.
- 02 G-2 OCCURS 2.
- 03 G-3 OCCURS 2.
- 04 G-4 OCCURS 2.
- 05 G-5 OCCURS 2.
- 06 G-6 OCCURS 2.
- 07 G-7 OCCURS 2.
- 08 G-8 OCCURS 2.
- 09 X PIC X.
-])
-
-AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], [])
-
-AT_CLEANUP
-
# 10) TODO
diff --git a/gcc/cobol/UAT/testsuite.src/run_evaluate.at b/gcc/cobol/UAT/testsuite.src/run_evaluate.at
index 63a5f7ba280edd30004e9581f1e998f0a8cd6fa5..25aa6e2f219d14adfd25d14d07f3f2fe762eeb3a 100644
--- a/gcc/cobol/UAT/testsuite.src/run_evaluate.at
+++ b/gcc/cobol/UAT/testsuite.src/run_evaluate.at
@@ -31,6 +31,52 @@ AT_CHECK([./a.out], [0], [not
], [])
AT_CLEANUP
+AT_SETUP([EVALUATE condition (2)])
+AT_KEYWORDS([evaluate condition])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 XVAL PIC X VALUE '_'.
+ 88 UNDERSCORE VALUE '_'.
+ PROCEDURE DIVISION.
+ DISPLAY 'Next line should be "UNDERSCORE evaluates to TRUE"'
+ EVALUATE TRUE
+ WHEN NOT UNDERSCORE
+ DISPLAY
+ "***IMPROPERLY*** NOT UNDERSCORE evaluates to TRUE"
+ END-DISPLAY
+ END-EVALUATE.
+ EVALUATE TRUE
+ WHEN UNDERSCORE
+ DISPLAY "UNDERSCORE evaluates to TRUE"
+ END-DISPLAY
+ END-EVALUATE.
+
+ DISPLAY
+ 'Next line should be "NOT UNDERSCORE evaluates to FALSE"'
+ EVALUATE FALSE
+ WHEN NOT UNDERSCORE
+ DISPLAY "NOT UNDERSCORE evaluates to FALSE"
+ END-DISPLAY
+ END-EVALUATE.
+ EVALUATE FALSE
+ WHEN UNDERSCORE
+ DISPLAY
+ "***IMPROPERLY*** UNDERSCORE evaluates to FALSE"
+ END-DISPLAY
+ END-EVALUATE.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([./a.out], [0], [Next line should be "UNDERSCORE evaluates to TRUE"
+UNDERSCORE evaluates to TRUE
+Next line should be "NOT UNDERSCORE evaluates to FALSE"
+NOT UNDERSCORE evaluates to FALSE
+], [])
+AT_CLEANUP
+
AT_SETUP([EVALUATE with WHEN using condition-1])
# Gnu DOES NOT support condition names as Evaluate object
diff --git a/gcc/cobol/UAT/testsuite.src/run_functions.at b/gcc/cobol/UAT/testsuite.src/run_functions.at
index 1545173ebbfe7e6b987a7420ec7a2173c0d8df24..bff4e719f7fb5785901c559a237bd26f9d47373a 100644
--- a/gcc/cobol/UAT/testsuite.src/run_functions.at
+++ b/gcc/cobol/UAT/testsuite.src/run_functions.at
@@ -3495,6 +3495,104 @@ AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], ["Santa Claus
], [])
AT_CLEANUP
+AT_SETUP([UDF in COMPUTE])
+AT_KEYWORDS([functions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ FUNCTION-ID. func.
+
+ DATA DIVISION.
+ LINKAGE SECTION.
+ 01 num PIC 999.
+
+ PROCEDURE DIVISION RETURNING num.
+ MOVE 100 TO num
+ .
+ END FUNCTION func.
+
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+
+ ENVIRONMENT DIVISION.
+ CONFIGURATION SECTION.
+ REPOSITORY.
+ FUNCTION func.
+
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 x PIC 999.
+
+ PROCEDURE DIVISION.
+ COMPUTE x = 101 + FUNCTION func
+ DISPLAY x
+ .
+ END PROGRAM prog.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[201
+])
+AT_CLEANUP
+
+AT_SETUP([UDF with recursion])
+AT_KEYWORDS([functions LOCAL-STORAGE])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ FUNCTION-ID. foo.
+
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 ttl PIC 9 VALUE 1.
+
+ LOCAL-STORAGE SECTION.
+ 01 num PIC 9.
+
+ LINKAGE SECTION.
+ 01 arg PIC 9.
+ 01 ret PIC 9.
+
+ PROCEDURE DIVISION USING arg RETURNING ret.
+ IF arg < 5
+ ADD 1 TO arg GIVING num END-ADD
+ MOVE FUNCTION foo (num) TO ret
+ ELSE
+ MOVE arg TO ret
+ END-IF
+ DISPLAY "Step: " ttl ", Arg: " arg ", Return: " ret
+ END-DISPLAY
+ ADD 1 to ttl END-ADD
+ GOBACK.
+ END FUNCTION foo.
+
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+
+ ENVIRONMENT DIVISION.
+ CONFIGURATION SECTION.
+ REPOSITORY.
+ FUNCTION foo.
+
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 num PIC 9 VALUE 1.
+
+ PROCEDURE DIVISION.
+ DISPLAY "Return value '" FUNCTION foo (num) "'"
+ WITH NO ADVANCING
+ END-DISPLAY
+ GOBACK.
+ END PROGRAM prog.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0],
+[Step: 1, Arg: 5, Return: 5
+Step: 2, Arg: 4, Return: 5
+Step: 3, Arg: 3, Return: 5
+Step: 4, Arg: 2, Return: 5
+Step: 5, Arg: 1, Return: 5
+Return value '5'], [])
+AT_CLEANUP
+
AT_SETUP([Program-to-program parameters and retvals])
AT_KEYWORDS([functions parameter])
AT_DATA([prog.cob], [ IDENTIFICATION DIVISION.
diff --git a/gcc/cobol/UAT/testsuite.src/run_fundamental.at b/gcc/cobol/UAT/testsuite.src/run_fundamental.at
index 018a815e963abdd299cd89b87c4d52221d665105..7c9465117718a7536adb7f0065af3e204127e60b 100644
--- a/gcc/cobol/UAT/testsuite.src/run_fundamental.at
+++ b/gcc/cobol/UAT/testsuite.src/run_fundamental.at
@@ -914,6 +914,25 @@ AT_CHECK([./a.out], [0], [0], [])
AT_CLEANUP
+AT_SETUP([Context sensitive words (5)])
+AT_KEYWORDS([fundamental recursive])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog RECURSIVE.
+ ENVIRONMENT DIVISION.
+ CONFIGURATION SECTION.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 RECURSIVE PIC 9 VALUE 0.
+ PROCEDURE DIVISION.
+ DISPLAY RECURSIVE NO ADVANCING
+ END-DISPLAY.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([./a.out], [0], [0], [])
+AT_CLEANUP
+
AT_SETUP([Context sensitive words (6)])
AT_KEYWORDS([fundamental normal])
AT_DATA([prog.cob], [
diff --git a/gcc/cobol/UAT/testsuite.src/run_misc.at b/gcc/cobol/UAT/testsuite.src/run_misc.at
index 861d714744e950ce7b527fc0bfcad996e895b40b..b9bdc50d834e617431e6b5d251b08a8e76a080a7 100644
--- a/gcc/cobol/UAT/testsuite.src/run_misc.at
+++ b/gcc/cobol/UAT/testsuite.src/run_misc.at
@@ -3421,3 +3421,312 @@ On exit: 004
On exit: 005
], [])
AT_CLEANUP
+
+AT_SETUP([Recursive CALL of RECURSIVE program])
+AT_KEYWORDS([misc CANCEL EXTERNAL])
+AT_DATA([caller.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. caller IS RECURSIVE.
+ ENVIRONMENT DIVISION.
+ CONFIGURATION SECTION.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 STOPPER PIC S9 EXTERNAL.
+ PROCEDURE DIVISION.
+ MOVE 0 TO STOPPER
+ CALL "callee"
+ DISPLAY 'OK' NO ADVANCING END-DISPLAY
+ *> FIXME: CANCEL broken on special environments
+ *> CANCEL "callee" , "callee2"
+ DISPLAY ' + FINE' NO ADVANCING END-DISPLAY
+ STOP RUN.
+])
+AT_DATA([callee.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. callee IS RECURSIVE.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 STOPPER PIC S9 EXTERNAL.
+ PROCEDURE DIVISION.
+ IF STOPPER = 9
+ MOVE -1 TO STOPPER
+ ELSE
+ ADD 1 TO STOPPER
+ CALL "callee2"
+ END-IF
+ GOBACK.
+])
+AT_DATA([callee2.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. callee2 IS RECURSIVE.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 STOPPER PIC S9 EXTERNAL.
+ PROCEDURE DIVISION.
+ IF STOPPER NOT EQUAL -1
+ CALL "callee"
+ END-IF
+ GOBACK.
+])
+
+AT_CHECK([$COMPILE -c callee.cob], [0], [], [])
+AT_CHECK([$COMPILE -c callee2.cob], [0], [], [])
+AT_CHECK([$COMPILE -o caller caller.cob callee.o callee2.o], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [OK + FINE], [])
+AT_CLEANUP
+
+
+AT_SETUP([Recursive CALL of INITIAL program])
+AT_KEYWORDS([misc])
+AT_DATA([caller.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. caller.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 STOPPER PIC 9 EXTERNAL.
+ PROCEDURE DIVISION.
+ MOVE 0 TO STOPPER
+ CALL "callee" END-CALL.
+ GOBACK.
+])
+AT_DATA([callee.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. callee IS INITIAL.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 STOPPER PIC 9 EXTERNAL.
+ PROCEDURE DIVISION.
+ IF STOPPER = 1
+ DISPLAY 'INITIAL prog was called RECURSIVE'
+ END-DISPLAY
+ * Following statement not ISO, corrected below
+ * STOP RUN RETURNING 1
+ MOVE 1 TO RETURN-CODE
+ STOP RUN
+ ELSE
+ MOVE 1 TO STOPPER
+ CALL "callee2" END-CALL
+ END-IF.
+ GOBACK.
+])
+AT_DATA([callee2.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. callee2.
+ PROCEDURE DIVISION.
+ CALL "callee" END-CALL.
+ GOBACK.
+])
+AT_CHECK([$COMPILE -c callee.cob], [0], [], [])
+AT_CHECK([$COMPILE -c callee2.cob], [0], [], [])
+AT_CHECK([$COMPILE -o caller caller.cob callee.o callee2.o], [0], [], [])
+AT_CHECK([./caller], [1], [INITIAL prog was called RECURSIVE
+], [])
+AT_CLEANUP
+
+
+AT_SETUP([Recursive CALL with RECURSIVE assumed])
+AT_KEYWORDS([misc])
+AT_DATA([caller.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. caller.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 STOPPER PIC 9 EXTERNAL.
+ PROCEDURE DIVISION.
+ MOVE 0 TO STOPPER
+ CALL "callee" END-CALL.
+ GOBACK.
+])
+AT_DATA([callee.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. callee IS INITIAL.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 77 STOPPER PIC 9 EXTERNAL.
+ PROCEDURE DIVISION.
+ IF STOPPER = 8
+ DISPLAY 'OK' NO ADVANCING END-DISPLAY.
+ IF STOPPER NOT = 9
+ ADD 1 TO STOPPER END-ADD
+ CALL "callee2" END-CALL.
+ GOBACK.
+])
+AT_DATA([callee2.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. callee2.
+ PROCEDURE DIVISION.
+ CALL "callee" END-CALL.
+ GOBACK.
+])
+AT_CHECK([$COMPILE -c callee.cob], [0], [], [])
+AT_CHECK([$COMPILE -c callee2.cob], [0], [], [])
+AT_CHECK([$COMPILE -o caller caller.cob callee.o callee2.o], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [OK], [])
+AT_CLEANUP
+
+
+AT_SETUP([PERFORM inline (1)])
+AT_KEYWORDS([misc])
+AT_DATA([prog.cob], [
+ 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
+ .
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([PERFORM inline (2)])
+AT_KEYWORDS([misc])
+AT_DATA([prog.cob], [
+ 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
+ .
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([UNSTRING DELIMITER IN])
+AT_KEYWORDS([misc])
+AT_DATA([prog.cob], [
+ 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.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([PERFORM type OSVS])
+AT_KEYWORDS([misc])
+AT_DATA([prog.cob], [
+ 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.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], [])
+AT_CLEANUP
+
+
+AT_SETUP([Sticky LINKAGE])
+AT_KEYWORDS([misc])
+AT_DATA([callee.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. callee.
+ DATA DIVISION.
+ LINKAGE SECTION.
+ 01 P1 PIC X.
+ 01 P2 PIC X(6).
+ 01 P3 PIC X(6).
+ PROCEDURE DIVISION USING P1 P2.
+ IF P1 = "A"
+ SET ADDRESS OF P3 TO ADDRESS OF P2
+ ELSE
+ IF P3 NOT = "OKOKOK"
+ DISPLAY P3
+ END-DISPLAY
+ END-IF
+ END-IF.
+ EXIT PROGRAM.
+])
+AT_DATA([caller.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. caller.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 P1 PIC X VALUE "A".
+ 01 P2 PIC X(6) VALUE "NOT OK".
+ PROCEDURE DIVISION.
+ CALL "callee" USING P1 P2
+ END-CALL.
+ MOVE "B" TO P1.
+ MOVE "OKOKOK" TO P2.
+ CALL "callee" USING P1
+ END-CALL.
+ STOP RUN.
+])
+AT_CHECK([$COMPILE -c callee.cob], [0], [], [])
+AT_CHECK([$COMPILE -o caller caller.cob callee.o], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], [])
+AT_CLEANUP
diff --git a/gcc/cobol/UAT/testsuite.src/syn_definition.at b/gcc/cobol/UAT/testsuite.src/syn_definition.at
index 407e24ced5f7bd110906feff6110968aeb3f3f48..37812ea0998892698f71acd412645f73b1e8bffb 100644
--- a/gcc/cobol/UAT/testsuite.src/syn_definition.at
+++ b/gcc/cobol/UAT/testsuite.src/syn_definition.at
@@ -98,6 +98,27 @@ AT_CHECK([$COMPILE_ONLY SHORT.cob], [0], [], [])
AT_CHECK([./prog], [0], [], [])
AT_CLEANUP
+AT_SETUP([INITIAL / RECURSIVE before COMMON])
+AT_KEYWORDS([PROGRAM-ID definition])
+AT_DATA([containing-prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. containing-prog.
+ PROCEDURE DIVISION.
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog-1 IS INITIAL COMMON.
+ PROCEDURE DIVISION.
+ STOP RUN.
+ END PROGRAM prog-1.
+
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog-2 IS RECURSIVE COMMON.
+ PROCEDURE DIVISION.
+ STOP RUN.
+ END PROGRAM prog-2.
+])
+AT_CHECK([$COMPILE_ONLY containing-prog.cob], [0], [], [])
+AT_CLEANUP
+
AT_SETUP([Invalid PROGRAM-ID type clause (1)])
AT_KEYWORDS([definition])
@@ -664,6 +685,28 @@ badprog.cob:12: error: 77 OUTPUT-NAME SAME AS MESSAGE-TEXT-2: must be elementary
.:13: 5 errors in DATA DIVISION, compilation ceases detected at end of file
cobol1: error: failed compiling badprog.cob
])
+AT_CLEANUP
+AT_SETUP([ALPHABET definition])
+AT_KEYWORDS([definition])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ ENVIRONMENT DIVISION.
+ CONFIGURATION SECTION.
+ SPECIAL-NAMES.
+ ALPHABET TESTME IS
+ 'A' THROUGH 'Z', x'00' thru x'05';
+ x'41' ALSO x'42', ALSO x'00', x'C1' ALSO x'C2'.
+ ALPHABET FINE
+ 'A' also 'B' also 'C' also 'd' also 'e' ALSO 'f',
+ 'g' also 'G', '1' thru '9', x'00'.
+])
+AT_CHECK([$COMPILE_ONLY prog.cob], [1], [],
+[prog.cob:9: error: ALPHABET , character 'A' (x'41') in position 32 already defined at position 0 at 'ALSO'
+prog.cob:10: 1 errors in DATA DIVISION, compilation ceases at 'ALPHABET'
+cobol1: error: failed compiling prog.cob
+])
AT_CLEANUP
+
diff --git a/gcc/cobol/UAT/testsuite.src/syn_misc.at b/gcc/cobol/UAT/testsuite.src/syn_misc.at
index 791cb5f9dc07c541b80d056d3c79583a7680d748..2901cc0580e49db156ddc72664eec3bb936f65e7 100644
--- a/gcc/cobol/UAT/testsuite.src/syn_misc.at
+++ b/gcc/cobol/UAT/testsuite.src/syn_misc.at
@@ -841,3 +841,16 @@ cobol1: error: failed compiling prog.cob
])
AT_CLEANUP
+AT_SETUP([swapped SOURCE- and OBJECT-COMPUTER])
+AT_KEYWORDS([misc extensions])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+
+ ENVIRONMENT DIVISION.
+ CONFIGURATION SECTION.
+ OBJECT-COMPUTER. a.
+ SOURCE-COMPUTER. b.
+])
+AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], [])
+AT_CLEANUP
diff --git a/gcc/cobol/UAT/testsuite.src/syn_occurs.at b/gcc/cobol/UAT/testsuite.src/syn_occurs.at
index 729bcb0bf2cbdead353ece9266a3e4e1890ea45d..33842c9480b65e9fb09438285877faeadc2a1cb9 100644
--- a/gcc/cobol/UAT/testsuite.src/syn_occurs.at
+++ b/gcc/cobol/UAT/testsuite.src/syn_occurs.at
@@ -21,3 +21,23 @@
### ISO+IEC+1989-2002 13.16.36 OCCURS clause
### ISO+IEC+1989-202x 3rd WD 13.18.38 OCCURS clause
+AT_SETUP([Nested OCCURS clause])
+AT_KEYWORDS([occurs])
+# NOT IMPLEMENTED: Diagnostic messages
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 G-1.
+ 02 G-2 OCCURS 2.
+ 03 G-3 OCCURS 2.
+ 04 G-4 OCCURS 2.
+ 05 G-5 OCCURS 2.
+ 06 G-6 OCCURS 2.
+ 07 G-7 OCCURS 2.
+ 08 G-8 OCCURS 2.
+ 09 X PIC X.
+])
+AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], [])
+AT_CLEANUP