From 42ebf2c0de228754e40167efb78802cc491755ab Mon Sep 17 00:00:00 2001
From: David Declerck <david.declerck@ocamlpro.com>
Date: Thu, 13 Jun 2024 22:38:41 +0200
Subject: [PATCH] Merge SVN 4104

---
 cobc/codegen.c                        | 66 ++++++++++++++-------------
 tests/testsuite.src/run_initialize.at |  2 +
 2 files changed, 37 insertions(+), 31 deletions(-)

diff --git a/cobc/codegen.c b/cobc/codegen.c
index 0e8a7e197..1a2946f7b 100644
--- a/cobc/codegen.c
+++ b/cobc/codegen.c
@@ -5259,40 +5259,39 @@ propagate_table (cb_tree x, int bgn_idx)
 	  && !f->depending)) {
 		/* Table size is known at compile time */
 		/* Generate inline 'memcpy' to propagate the array data */
-		if (occ > 1) {
-			output_block_open ();
+		output_block_open ();
+		output_prefix ();
+		output ("cob_u8_ptr b_ptr = ");
+		output_data(x);
+		if (bgn_idx > 1) {
+			output (" + %ld",len * (bgn_idx - 1));
+			maxlen -= len * (bgn_idx - 1);
+		}
+		output (";");
+		output_newline ();
+
+		/* double the chunks each time */
+		do {
 			output_prefix ();
-			output ("cob_u8_ptr b_ptr = ");
-			output_data(x);
-			if (bgn_idx > 1) {
-				output (" + %ld",len * (bgn_idx - 1));
-				maxlen -= len * (bgn_idx - 1);
-			}
-			output (";");
+			output ("memcpy (b_ptr + %6lu, b_ptr, %6lu);", len, len);
+			output ("\t/* %s: %6u thru %u */",
+					f->name, j + bgn_idx, j * 2 + bgn_idx - 1);
 			output_newline ();
-			/* double the chunks each time */
-			do {
-				output_prefix ();
-				output ("memcpy (b_ptr + %6lu, b_ptr, %6lu);", len, len);
-				output ("\t/* %s: %5d thru %d */",
-						f->name, j + bgn_idx, j * 2 + bgn_idx - 1);
-				output_newline ();
-				j = j * 2;
-				len = len * 2;
-			} while ((j * 2) < occ);
+			j = j * 2;
+			len = len * 2;
+		} while ((j * 2) < occ);
 
-			/* missing piece after last chunk */
-			if (j < occ
-			 && maxlen > len) {
-				output_prefix ();
-				output ("memcpy (b_ptr + %6lu, b_ptr, %6lu);",
-					len, maxlen - len);
-				output ("\t/* %s: %5d thru %d */",
-					f->name, j + bgn_idx, occ);
-				output_newline ();
-			}
-			output_block_close ();
+		/* missing piece after last chunk */
+		if (j < occ
+		 && maxlen > len) {
+			output_prefix ();
+			output ("memcpy (b_ptr + %6lu, b_ptr, %6lu);",
+				len, maxlen - len);
+			output ("\t/* %s: %6u thru %u */",
+				f->name, j + bgn_idx, occ);
+			output_newline ();
 		}
+		output_block_close ();
 	} else {
 		/* Table size is only known at run time */
 		output_prefix ();
@@ -6089,11 +6088,12 @@ output_initialize_compound (struct cb_initialize *p, cb_tree x)
 				}
 			} else {
 				struct cb_reference *ref = CB_REFERENCE (c);
-				cb_tree			save_length, r2;
+				cb_tree			save_check, save_length, r2;
 
 				/* Output initialization for the first record */
 				output_line ("/* initialize first record for %s */", f->name);
 				save_length = ref->length;
+				save_check = ref->check;
 				/* Output all 'check' first */
 				for (r2 = ref->check; r2; r2 = CB_CHAIN (r2)) {
 					output_stmt (CB_VALUE (r2));
@@ -6123,6 +6123,9 @@ output_initialize_compound (struct cb_initialize *p, cb_tree x)
 					}
 				}
 
+				/* all exceptions should have been raised above,
+				   so temporarily detach from the reference */
+				ref->check = NULL;
 				ref->length = NULL;
 
 				for (pf = f; pf && !pf->flag_occurs_values; pf = pf->parent);
@@ -6134,6 +6137,7 @@ output_initialize_compound (struct cb_initialize *p, cb_tree x)
 				}
 
 				/* restore previous exception-checks for the reference */
+				ref->check = save_check;
 				ref->length = save_length;
 			}
 		}
diff --git a/tests/testsuite.src/run_initialize.at b/tests/testsuite.src/run_initialize.at
index 085f71550..f64c8a8cf 100644
--- a/tests/testsuite.src/run_initialize.at
+++ b/tests/testsuite.src/run_initialize.at
@@ -406,7 +406,9 @@ AT_CHECK([$COMPILE prog.cob], [0], [], [])
 AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], [])
 AT_CHECK([$COMPILE prog2.cob], [0], [], [])
 AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], [])
+# CHECKME: that should likely be implied with -std=ibm
 #AT_CHECK([$COMPILE -std=ibm prog3.cob], [0], [], [])
+#AT_CHECK([$COMPILE -fodoslide prog3.cob], [0], [], [])
 #AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], [], [])
 
 AT_CLEANUP