Fixes for 4935

cobc/ChangeLog

@@ -1,4 +1,10 @@
 
+2024-10-07  David Declerck <[email protected]>
+
+	Adjustments to merge 2023-01-16:
+	* codegen.c (output_perform_until): fix index bound checking
+	  to make it work with code merged from 3.x
+
 2024-08-28  David Declerck <[email protected]>
 
 	* tree.c (char_to_precedence_idx, get_char_type_description, valid_char_order):

cobc/codegen.c

@@ -8252,6 +8252,32 @@ output_perform_until (struct cb_perform *p, cb_tree l)
 	cb_tree				next;
 
 	if (l == NULL) {
+		if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT)) {
+			cb_tree	xn;
+			/* Check all INDEXED BY variables used in VARYING */
+			for (xn = p->varying; xn; xn = CB_CHAIN (xn)) {
+				struct cb_field		*q;
+				v = CB_PERFORM_VARYING (CB_VALUE (xn));
+				if (!v->name) continue;
+				f = CB_FIELD_PTR (v->name);
+				if (!f->flag_indexed_by) continue;
+				if (!f->index_qual) continue;
+				q = f->index_qual;
+				output_prefix ();
+				output ("cob_check_subscript (");
+				output_integer (CB_PERFORM_VARYING(CB_VALUE (xn))->name);
+				output (", ");
+				if (q->depending) {
+					output_integer (q->depending);
+					output (", \"%s\", 1", q->name);
+				} else {
+					output ("%d, \"%s\", 0", q->occurs_max, q->name);
+				}
+				output (");");
+				output_newline ();
+			}
+		}
+
 		/* Perform body at the end */
 		output_perform_once (p);
 		return;
@@ -8308,30 +8334,6 @@ output_perform_until (struct cb_perform *p, cb_tree l)
 	output (")");
 	output_newline ();
 	output_line ("  break;");
-	if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT)
-	 && next) {
-		cb_tree	xn;
-		/* Check all INDEXED BY variables used in VARYING */
-		for (xn = l; xn; xn = NULL /*CB_CHAIN (xn)*/) {
-			struct cb_field		*q;
-			f = CB_FIELD_PTR (CB_PERFORM_VARYING(CB_VALUE (xn))->name);
-			if (!f->flag_indexed_by) continue;
-			if (!f->index_qual) continue;
-			q = f->index_qual;
-			output_prefix ();
-			output ("cob_check_subscript (");
-			output_integer (CB_PERFORM_VARYING(CB_VALUE (xn))->name);
-			output (", ");
-			if (q->depending) {
-				output_integer (q->depending);
-				output (", \"%s\", 1",f->name);
-			} else {
-				output ("%d, \"%s\", 0",q->occurs_max,f->name);
-			}
-			output (");");
-			output_newline ();
-		}
-	}
 
 	if (p->test == CB_BEFORE) {
 		output_perform_until (p, next);

tests/testsuite.src/run_subscripts.at

@@ -631,7 +631,7 @@ AT_DATA([prog.cob], [
            END-PERFORM.
            STOP RUN.
            END PROGRAM prog.
-       
+
        IDENTIFICATION DIVISION.
        PROGRAM-ID. SUBN.
        DATA DIVISION.
@@ -660,7 +660,7 @@ Number is +0000000003
 +01: A: Freddy  .
 +02: B: Barney  .
 +03: C: Wilma   .
-], [libcob: prog.cob:80: error: subscript of 'MYMRK' out of bounds: 4
+], [libcob: prog.cob:73: error: subscript of 'MYMRK' out of bounds: 4
 note: current maximum subscript for 'MYMRK': 3
 ])