fix profiling of EVALUATE

cobc/ChangeLog

@@ -1,5 +1,21 @@
 
-2022-12-08  Simon Sobisch <simonsobisch@gnu.org>
+2025-01-06  Fabrice Le Fessant <fabrice.le_fessant@ocamlpro.com>
+
+	* parser.y (rule occurs_index): set index_type to CB_INT_INDEX
+	  also for INDEXED BY appaering in LINKAGE SECTION, otherwise
+	  the variable is not added to the local include file
+
+2025-01-03  Fabrice Le Fessant <fabrice.le_fessant@ocamlpro.com>
+
+	* typeck.c (build_evaluate, cb_check_needs_break): fix a bug where
+	  EVALUATE fails in profiling mode. The reason was that a check for
+	  a last GOTO statement is not correctly written, because it was
+	  actually checking either a GOTO or not a statement, which was
+	  evaluates to true for instructions added by profiling. Fixed by
+	  checking only that the last statement is a GOTO. Also modify
+	  cb_check_needs_break that uses the same code.
+
+2024-12-08  Simon Sobisch <simonsobisch@gnu.org>
 
 	* cobc.c (process_command_line): fix leak for --copy and -include parsing
 

cobc/parser.y

@@ -8569,7 +8569,8 @@ occurs_index:
 	const cb_tree init_val = cb_default_byte == CB_DEFAULT_BYTE_INIT
 	                       ? cb_int1 : NULL;
 	$$ = cb_build_index ($1, init_val, 1U, current_field);
-	if (storage == CB_STORAGE_LOCAL) {
+	if (storage == CB_STORAGE_LOCAL ||
+		storage == CB_STORAGE_LINKAGE) {
 		CB_FIELD_PTR ($$)->index_type = CB_INT_INDEX;
 	} else {
 		CB_FIELD_PTR ($$)->index_type = CB_STATIC_INT_INDEX;

cobc/typeck.c

@@ -797,6 +797,7 @@ static cb_tree
 cb_check_needs_break (cb_tree stmt)
 {
 	cb_tree		l;
+	int  needs_a_break = 1 ;
 
 	/* Check if last statement is GO TO */
 	for (l = stmt; l; l = CB_CHAIN (l)) {
@@ -806,12 +807,15 @@ cb_check_needs_break (cb_tree stmt)
 	}
 	if (l && CB_VALUE (l) && CB_STATEMENT_P (CB_VALUE (l))) {
 		l = CB_STATEMENT(CB_VALUE(l))->body;
-		if (l && CB_VALUE (l) && !CB_GOTO_P (CB_VALUE(l))) {
-			/* Append a break */
-			l = cb_build_direct ("break;", 0);
-			return cb_list_add (stmt, l);
+		if (l && CB_VALUE (l) && CB_GOTO_P (CB_VALUE(l))) {
+			needs_a_break = 0;
 		}
 	}
+
+	if (needs_a_break){
+		l = cb_build_direct ("break;", 0);
+		return cb_list_add (stmt, l);
+	}
 	return stmt;
 }
 
@@ -10019,6 +10023,7 @@ build_evaluate (cb_tree subject_list, cb_tree case_list, cb_tree goto_end_label)
 		cb_source_line = old_line;
 
 	} else {
+		int need_end_goto = 1 ;
 		c2 = stmt;
 		/* Check if last statement is GO TO */
 		for (c3 = stmt; c3; c3 = CB_CHAIN (c3)) {
@@ -10028,11 +10033,14 @@ build_evaluate (cb_tree subject_list, cb_tree case_list, cb_tree goto_end_label)
 		}
 		if (c3 && CB_VALUE (c3) && CB_STATEMENT_P (CB_VALUE (c3))) {
 			c3 = CB_STATEMENT (CB_VALUE (c3))->body;
-			if (c3 && CB_VALUE (c3) && !CB_GOTO_P (CB_VALUE(c3))) {
-				/* Append the jump */
-				c2 = cb_list_add (stmt, goto_end_label);
+			if (c3 && CB_VALUE (c3) && CB_GOTO_P (CB_VALUE(c3))) {
+				need_end_goto = 0 ;
 			}
 		}
+		if (need_end_goto){
+			/* Append the jump */
+			c2 = cb_list_add (stmt, goto_end_label);
+		}
 		cb_emit (cb_build_if (cb_build_cond (c1), c2, NULL, STMT_WHEN));
 		build_evaluate (subject_list, CB_CHAIN (case_list), goto_end_label);
 	}