diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 9c6bf8b19..61f1ceae4 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -1,9 +1,13 @@ - 2024-02-19 Boris Eng * parser.y (screen_value_clause): replaced basic literals by literals +2024-01-28 Fabrice Le Fessant + + * parser.y: fix SEGFAULT when checking the BY VALUE arguments of a + prototype with ANY LENGTH + 2024-01-25 David Declerck FR #459: support COLLATING SEQUENCE clause on SELECT / INDEXED files diff --git a/cobc/parser.y b/cobc/parser.y index 8beb49d87..c6b82bf1f 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -11015,9 +11015,12 @@ procedure_param: } if (call_mode == CB_CALL_BY_VALUE - && CB_REFERENCE_P ($4) - && CB_FIELD (cb_ref ($4))->flag_any_length) { - cb_error_x ($4, _("ANY LENGTH items may only be BY REFERENCE formal parameters")); + && CB_REFERENCE_P ($4)){ + cb_tree fx = cb_ref ($4); + if (fx != cb_error_node + && CB_FIELD (fx)->flag_any_length) { + cb_error_x ($4, _("ANY LENGTH items may only be BY REFERENCE formal parameters")); + } } $$ = CB_BUILD_PAIR (cb_int (call_mode), x); diff --git a/tests/testsuite.src/syn_misc.at b/tests/testsuite.src/syn_misc.at index 8a11f5128..5b9aff259 100644 --- a/tests/testsuite.src/syn_misc.at +++ b/tests/testsuite.src/syn_misc.at @@ -5776,6 +5776,8 @@ prog.cob:8: error: syntax error, unexpected Literal ]) AT_CLEANUP +# Let's add a double quote here " to match the one in the error and +# please emacs coloring... # normal register extension, # active for lax and standard configurations @@ -8348,3 +8350,38 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [1]) AT_CLEANUP + +AT_SETUP([PROTOTYPE parameter validation]) +AT_KEYWORDS([prototypes VALUE]) + +AT_DATA([prog.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. f PROTOTYPE. + DATA DIVISION. + LINKAGE SECTION. + 01 a PIC X(20). + 01 b ANY LENGTH. + *> BINARY-C-INT usage does not exist: error on purpose to + *> trigger an error below + 01 c USAGE BINARY-C-INT. + *> level 78 triggers an error, but not the expected one: the + *> string replaces the identifier in the scanner, so it becomes + *> a syntax error instead of a complain about level 78 + 78 d-const VALUE "abc". + PROCEDURE DIVISION + USING a + BY REFERENCE b + BY VALUE b + c + *> d-const + RETURNING OMITTED. + END PROGRAM f. +]) + +AT_CHECK([$COMPILE_ONLY -Wno-unfinished prog.cob], [1], [], +[prog.cob:10: error: unknown USAGE: BINARY-C-INT +prog.cob:18: error: ANY LENGTH items may only be BY REFERENCE formal parameters +]) + +AT_CLEANUP +