From debab31603633b10b720825f64a20dd47cd1d041 Mon Sep 17 00:00:00 2001
From: Bob Dubner <rdubner@symas.com>
Date: Thu, 4 Jan 2024 22:45:16 -0500
Subject: [PATCH] Expanded UAT/failsuite. Things that are FAILED should be
fixable.
---
gcc/cobol/UAT/failsuite.src/syn_definition.at | 199 ++++++++----------
1 file changed, 89 insertions(+), 110 deletions(-)
diff --git a/gcc/cobol/UAT/failsuite.src/syn_definition.at b/gcc/cobol/UAT/failsuite.src/syn_definition.at
index dc5188d7c9e2..88282ffb9cc9 100644
--- a/gcc/cobol/UAT/failsuite.src/syn_definition.at
+++ b/gcc/cobol/UAT/failsuite.src/syn_definition.at
@@ -18,64 +18,21 @@
### GnuCOBOL Test Suite
-###
-### Invalid PROGRAM-ID
-###
-
-AT_SETUP([401 Invalid source name])
-AT_KEYWORDS([definition])
-AT_SKIP_IF([test "$COB_DIALECT" != "gnu"])
-# FIXME: message
-
-# The message is currently inscrutable, but so is the test bogus.
-# gcobol doesn't consider "short" to be an invalid program-id because
-# it's not generating C code. The message could be better, but it's
-# tedious to fix, and there's no program.
-
-AT_DATA([short.cob], [])
-
-AT_CHECK([$COMPILE_ONLY short.cob], [1], [],
-[short.cob: error: invalid file base name 'short' - name duplicates a 'C' keyword
-])
-
-AT_CLEANUP
-
-
-AT_SETUP([402 Invalid PROGRAM-ID])
-AT_XFAIL_IF([test "$int128_to_field" != "ok"])
-AT_KEYWORDS([definition])
-
-AT_DATA([SHORT.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. short.
- PROCEDURE DIVISION.
- STOP RUN.
-])
-
-AT_CHECK([$COMPILE_ONLY SHORT.cob], [0], [], [])
-AT_CHECK([./prog], [0], [], [])
-AT_CLEANUP
-
-
AT_SETUP([Redefinition of function-prototype name])
AT_KEYWORDS([definition])
-AT_XFAIL_IF([test "UDF" != "implemented"])
-
+# This needs a better error message
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
-
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
REPOSITORY.
- FUNCTION func
- .
+ FUNCTION func .
DATA DIVISION.
WORKING-STORAGE SECTION.
01 func PIC X.
])
-
AT_CHECK([$COMPILE_ONLY prog.cob], [1], [],
[prog.cob:8: warning: no definition/prototype seen for FUNCTION 'func'
prog.cob:12: error: syntax error, unexpected user function name
@@ -83,11 +40,56 @@ prog.cob:12: error: syntax error, unexpected user function name
AT_CLEANUP
-AT_SETUP([PROCEDURE DIVISION RETURNING item])
-AT_KEYWORDS([definition runmisc])
-AT_SKIP_IF([test "FUNCTION-ID" != "IMPLEMENTED"])
+AT_SETUP([Data item with same name as program-name])
+AT_KEYWORDS([definition])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ FUNCTION-ID. x.
+ DATA DIVISION.
+ LINKAGE SECTION.
+ 01 ret PIC 99.
+ PROCEDURE DIVISION RETURNING ret.
+ CONTINUE
+ .
+ END FUNCTION x.
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+ DATA DIVISION.
+ WORKING-STORAGE SECTION.
+ 01 x PIC 999 VALUE 134.
+ PROCEDURE DIVISION.
+ DISPLAY X.
+ GOBACK.
+ END PROGRAM prog.
+])
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([./a.out], [0], [134
+], [])
+AT_CLEANUP
+
+AT_SETUP([Screen section starts with 78-level])
+AT_KEYWORDS([screen definition])
+AT_XFAIL_IF([test "SCREEN" != "implemented"])
+AT_DATA([prog.cob], [
+ IDENTIFICATION DIVISION.
+ PROGRAM-ID. prog.
+
+ DATA DIVISION.
+ SCREEN SECTION.
+ 78 const VALUE "x".
+])
+
+AT_CHECK([$COMPILE_ONLY prog.cob], [0], [],
+[prog.cob:6: syntax error at 'SCREEN'
+])
+AT_CLEANUP
+
+
+
+AT_SETUP([PROCEDURE DIVISION RETURNING item (1)])
+AT_KEYWORDS([definition runmisc])
AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
FUNCTION-ID. func.
@@ -99,31 +101,52 @@ AT_DATA([prog.cob], [
GOBACK.
END FUNCTION func.
])
+AT_CHECK([$COMPILE_ONLY -c prog.cob], [0], [], [])
+AT_CLEANUP
+
+AT_SETUP([PROCEDURE DIVISION RETURNING item (2)])
+AT_KEYWORDS([definition runmisc])
AT_DATA([prog2.cob], [
IDENTIFICATION DIVISION.
FUNCTION-ID. func.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 PAR-OUT PIC 9.
+ *> The following line is an error, because PAR-OUT has to be in the
+ *> LINKAGE section
PROCEDURE DIVISION RETURNING PAR-OUT.
MOVE 4 TO PAR-OUT
GOBACK.
END FUNCTION func.
])
+AT_CHECK([$COMPILE_ONLY -c prog2.cob], [1], [],
+[prog2.cob:7: error: RETURNING item is not defined in LINKAGE SECTION
+])
+AT_CLEANUP
+AT_SETUP([PROCEDURE DIVISION RETURNING item (3)])
+AT_KEYWORDS([definition runmisc])
AT_DATA([prog3.cob], [
IDENTIFICATION DIVISION.
FUNCTION-ID. func.
DATA DIVISION.
LINKAGE SECTION.
+ *> The level 01 can't have an OCCURS clause
01 PAR-OUT PIC 9 OCCURS 10.
PROCEDURE DIVISION RETURNING PAR-OUT.
MOVE 4 TO PAR-OUT (1)
GOBACK.
END FUNCTION func.
])
+AT_CHECK([$COMPILE_ONLY -c prog3.cob], [0], [],
+[prog3.cob:7: error: RETURNING item should not have OCCURS
+prog3.cob:9: error: 'PAR-OUT' requires one subscript
+])
+AT_CLEANUP
+AT_SETUP([PROCEDURE DIVISION RETURNING item (4)])
+AT_KEYWORDS([definition runmisc])
AT_DATA([prog4.cob], [
IDENTIFICATION DIVISION.
FUNCTION-ID. func.
@@ -136,18 +159,34 @@ AT_DATA([prog4.cob], [
GOBACK.
END FUNCTION func.
])
+AT_CHECK([$COMPILE_ONLY -c prog4.cob], [0], [],
+[prog4.cob:8: error: RETURNING item must have level 01
+])
+AT_CLEANUP
+AT_SETUP([PROCEDURE DIVISION RETURNING item (5)])
+AT_KEYWORDS([definition runmisc])
AT_DATA([prog5.cob], [
IDENTIFICATION DIVISION.
FUNCTION-ID. func.
DATA DIVISION.
LINKAGE SECTION.
01 PAR PIC 9.
+ *> This is an error; USING and RETURNING can't be the same variable
PROCEDURE DIVISION USING PAR RETURNING PAR.
MOVE 4 TO PAR
GOBACK.
END FUNCTION func.
+])
+AT_CHECK([$COMPILE_ONLY -c prog5.cob], [1], [],
+[prog5.cob:7: error: 'PAR' USING item duplicates RETURNING item
+prog5.cob:18: error: 'PAR-OUT' REDEFINES field not allowed here
+])
+AT_CLEANUP
+AT_SETUP([PROCEDURE DIVISION RETURNING item (6)])
+AT_KEYWORDS([definition runmisc])
+AT_DATA([prog6.cob], [
IDENTIFICATION DIVISION.
FUNCTION-ID. func2.
DATA DIVISION.
@@ -159,67 +198,7 @@ AT_DATA([prog5.cob], [
GOBACK.
END FUNCTION func2.
])
-
-AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], [])
-AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [],
-[prog2.cob:7: error: RETURNING item is not defined in LINKAGE SECTION
+AT_CHECK([$COMPILE_ONLY -c prog6.cob], [1], [],
+[RETURNING item can't have REDEFINES or BASED clause
])
-AT_CHECK([$COMPILE_ONLY prog3.cob], [1], [],
-[prog3.cob:7: error: RETURNING item should not have OCCURS
-prog3.cob:9: error: 'PAR-OUT' requires one subscript
-])
-AT_CHECK([$COMPILE_ONLY prog4.cob], [1], [],
-[prog4.cob:8: error: RETURNING item must have level 01
-])
-AT_CHECK([$COMPILE_ONLY prog5.cob], [1], [],
-[prog5.cob:7: error: 'PAR' USING item duplicates RETURNING item
-prog5.cob:18: error: 'PAR-OUT' REDEFINES field not allowed here
-])
-
AT_CLEANUP
-
-
-AT_SETUP([Data item with same name as program-name])
-AT_KEYWORDS([definition])
-AT_SKIP_IF([test "FUNCTION-ID" != "IMPLEMENTED"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- FUNCTION-ID. x.
- DATA DIVISION.
- LINKAGE SECTION.
- 01 ret PIC 99.
- PROCEDURE DIVISION RETURNING ret.
- CONTINUE
- .
- END FUNCTION x.
-
-
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
- DATA DIVISION.
- WORKING-STORAGE SECTION.
- 01 x PIC 999 VALUE 134.
-])
-
-AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], [])
-AT_CLEANUP
-
-AT_SETUP([Screen section starts with 78-level])
-AT_KEYWORDS([screen definition])
-AT_XFAIL_IF([test "SCREEN" != "implemented"])
-
-AT_DATA([prog.cob], [
- IDENTIFICATION DIVISION.
- PROGRAM-ID. prog.
-
- DATA DIVISION.
- SCREEN SECTION.
- 78 const VALUE "x".
-])
-
-AT_CHECK([$COMPILE_ONLY prog.cob], [0], [],
-[prog.cob:6: syntax error at 'SCREEN'
-])
-AT_CLEANUP
-
--
GitLab