fix SEGFAULT in checking prototype arguments

cobc/ChangeLog

@@ -1,9 +1,13 @@
 
-
 2024-02-19  Boris Eng <[email protected]>
 
 	* parser.y (screen_value_clause): replaced basic literals by literals
 
+2024-01-28  Fabrice Le Fessant <[email protected]>
+
+	* parser.y: fix SEGFAULT when checking the BY VALUE arguments of a
+          prototype with ANY LENGTH
+
 2024-01-25  David Declerck <[email protected]>
 
 	FR #459: support COLLATING SEQUENCE clause on SELECT / INDEXED files

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);

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
+