Merge SVN 4935

NEWS

@@ -306,12 +306,15 @@ Open Plans:
    affected programs (with OCCURS DEPENDING ON) or compile with additional
    -fno-odoslide to get the same results as with older GnuCOBOL versions
 
-** the compile flag -fdefaultbyte was moved to a dialect configuration,
+** the compile flag -fdefaultbyte (initializarion for data-items without
+   an explicit VALUE) was moved to a dialect configuration;
    while -fdefaultbyte still works as before it is now implied as binary
-   zero with -std=ibm/mvs/bs2000, space for -std=mf/acu/rm/realia, and
+   zero with -std=ibm/mvs/bs2000/realia, space for -std=mf/acu/rm, and
    no defined initialization for -std=cobol85/cobol2002/cobol2014/xopen,
-   it is unchanged for -std=default (initialize to PICTURE/USAGE)
-   for compatibility to previous behavior compile with -fdefaultbyte=init
+   it is unchanged for -std=default (initialize to PICTURE/USAGE);
+   for compatibility to previous behavior compile with -fdefaultbyte=init;
+   note that initialization for INDEXED BY items honors the defaultbyte
+   configuration now, too
 
 ** the dialect configuration option larger-redefines-ok was changed to
    a support option larger-redefines; if specified on the command-line

build_windows/ChangeLog.txt

@@ -13,6 +13,10 @@
 	* makedist.cmd: first addition for CI output
 	* version_cobc.rc, version_libcob.rc: updated date + rev
 
+2023-01-16  Simon Sobisch <[email protected]>
+
+	* version_cobc.rc, version_libcob.rc: updated date + rev
+
 2022-12-17  Simon Sobisch <[email protected]>
 
 	* general for libcob+cobc: handle move of cconv module
@@ -43,7 +47,7 @@
 
 2021-11-06  Simon Sobisch <[email protected]>
 
-	* config.h.in: moved references to PACKACAGE_defines after the define,
+	* config.h.in: moved references to PACKAGE_defines after the define,
 	  fixing dist builds since 2020-10-27
 	* makedist.cmd: explicit search for "define PACKAGE_define" which fixes the
 	  multiple results
@@ -346,7 +350,7 @@
 	  version_libcob.rc, version_cobcrun.rc provided by Simon)
 
 
-Copyright 2014-2021 Free Software Foundation, Inc.
+Copyright 2014-2023 Free Software Foundation, Inc.
 
 Copying and distribution of this file, with or without modification, are
 permitted provided the copyright notice and this notice are preserved.

cobc/ChangeLog

@@ -197,6 +197,23 @@
 	* reserved.c (SEQUENCE): setting CB_CS_ALPHABET to allow code-name parsing
 	* parser.y, reserved.c: changed reference from 202x to 2023
 
+2023-01-16  Simon Sobisch <[email protected]>
+
+	* parser.y (occurs_index): only set VALUE 1 for defaultbyte == INIT
+	* tree.h (CB_DEFAULT_BYTE_INIT, CB_DEFAULT_BYTE_NONE), config.c, field.c,
+	  codegen.c: explicit defines instead of "only magic numbers"
+	* tree.c (cb_build_initialize), tree.h (struct cb_initialize), codegen.c
+	  (output_initialize_to_value): replaced flag_init_statement with statement
+	* parser.y (setup_occurs_min_max): validate occurs_max limit
+	* codegen.c (output_initialize_uniform): pass code-field instead of
+	  re-evaluating it
+	* codegen.c (output_initialize_multi_values): removed variable
+	  "total_occurs" fixing Wunused-but-set-variable
+	* codegen.c (output_stmt): dropped unused msgid
+	* typeck.c (cb_build_index): add internal index variables in LINKAGE to
+	  internal WORKING-STORAGE or internal LOCAL-STORAGE items depending on
+	  program->flag_recursive
+
 2023-01-15  Ron Norman <[email protected]>
 
 	* cobc.c: Make sure the 'schema' directory is created for -fsql

cobc/codegen.c

@@ -2865,7 +2865,7 @@ output_local_field_cache (struct cb_program *prog)
 				output ("/* %s is not local */", f->name);
 				output_newline ();
 			}
-			if (f->storage ==  CB_STORAGE_REPORT
+			if (f->storage == CB_STORAGE_REPORT
 			 && f->flag_occurs
 			 && f->occurs_max > 1) {
 				/* generate sub-fields and a comment each */
@@ -2941,7 +2941,7 @@ output_local_fields (struct cb_program *prog)
 			for (f = rep->records; f; f = f->sister) {
 				if (f->storage == CB_STORAGE_WORKING
 				&& !(f->report_flag & COB_REPORT_REF_EMITTED)) {
-					output_emit_field(cb_build_field_reference (f, NULL), NULL);
+					output_emit_field (cb_build_field_reference (f, NULL), NULL);
 				}
 			}
 		}
@@ -5047,11 +5047,11 @@ deduce_initialize_type (struct cb_initialize *p, struct cb_field *f,
 		return INITIALIZE_ONE;
 	}
 
-	if (f->flag_external && !p->flag_init_statement) {
+	if (f->flag_external && p->statement == STMT_INIT_STORAGE) {
 		return INITIALIZE_NONE;
 	}
 
-	if (f->redefines && (!topfield || !p->flag_init_statement)) {
+	if (f->redefines && (!topfield || p->statement != STMT_INITIALIZE)) {
 		return INITIALIZE_NONE;
 	}
 
@@ -5096,7 +5096,7 @@ deduce_initialize_type (struct cb_initialize *p, struct cb_field *f,
 	}
 
 	if (p->flag_default) {
-		if (cb_default_byte >= 0 && !p->flag_init_statement) {
+		if (p->statement == STMT_INIT_STORAGE && cb_default_byte >= 0) {
 			return INITIALIZE_DEFAULT;
 		}
 		switch (f->usage) {
@@ -5211,7 +5211,7 @@ static int
 initialize_uniform_char (const struct cb_field *f,
 			 const struct cb_initialize *p)
 {
-	if (cb_default_byte >= 0 && !p->flag_init_statement) {
+	if (p->statement == STMT_INIT_STORAGE && cb_default_byte >= 0) {
 		return cb_default_byte;
 	}
 
@@ -5425,10 +5425,9 @@ output_initialize_fp (cb_tree x, struct cb_field *f)
 }
 
 static void
-output_initialize_uniform (cb_tree x, const unsigned char cc, const int size)
+output_initialize_uniform (cb_tree x, struct cb_field *f,
+	const unsigned char cc, const int size)
 {
-	struct cb_field		*f = cb_code_field (x);
-
 	/* REPORT lines are cleared to SPACES */
 	if (f->storage == CB_STORAGE_REPORT
 	 && cc == ' ') {
@@ -5484,7 +5483,7 @@ static void
 output_initialize_chaining (struct cb_field *f, struct cb_initialize *p)
 {
 	/* only handle CHAINING for program initialization */
-	if (p->flag_init_statement) {
+	if (p->statement == STMT_INITIALIZE) {
 		return;
 	}
 	/* Note: CHAINING must be an extra initialization step as parameters not passed
@@ -5500,7 +5499,7 @@ output_initialize_chaining (struct cb_field *f, struct cb_initialize *p)
 
 static void
 output_initialize_to_value (struct cb_field *f, cb_tree x,
-			    const int flag_init_statement)
+		const enum cob_statement statement)
 {
 	cb_tree			value;
 	struct cb_literal	*l;
@@ -5529,7 +5528,7 @@ output_initialize_to_value (struct cb_field *f, cb_tree x,
 	}
 	/* Check for non-standard OCCURS */
 	if ((f->level == 1 || f->level == 77)
-	 && f->flag_occurs && !flag_init_statement) {
+	 && f->flag_occurs && statement == STMT_INIT_STORAGE) {
 		init_occurs = 1;
 	} else {
 		init_occurs = 0;
@@ -5813,13 +5812,11 @@ output_initialize_to_default (struct cb_field *f, cb_tree x)
 static void
 output_initialize_one (struct cb_initialize *p, cb_tree x)
 {
-	struct cb_field		*f;
-
-	f = cb_code_field (x);
+	struct cb_field	*f = cb_code_field (x);
 
 	/* Initialize TO VALUE */
 	if (p->val && f->values) {
-		output_initialize_to_value (f, x, p->flag_init_statement);
+		output_initialize_to_value (f, x, p->statement);
 		return;
 	}
 
@@ -5902,22 +5899,20 @@ output_initialize_multi_values (struct cb_initialize *p, cb_tree x, struct cb_fi
 	struct cb_field		*pftbl[COB_MAX_SUBSCRIPTS+1] = { NULL };
 	int			idxtbl[COB_MAX_SUBSCRIPTS+1] = { 0 };
 	int			occtbl[COB_MAX_SUBSCRIPTS+1] = { 0 };
-	int			idx, idx_clr, total_occurs;
+	int			idx, idx_clr;
 
 #if 0 /* CHECKME: the init above should be fine */
 	for (idx=0; idx <= COB_MAX_SUBSCRIPTS; idx++) {
 		idxtbl[idx] = 0;
 		pftbl[idx] = NULL;
 	}
 #endif
-	total_occurs = 1;
 	idx_clr = 0;
 	for (idx = 0, pf = f; pf; pf = pf->parent) {
 		if (pf->flag_occurs
 		 && pf->occurs_max > 1) {
 			pftbl [idx] = pf;
 			occtbl[idx] = pf->occurs_max;
-			total_occurs *= pf->occurs_max;
 			idx++;
 		}
 	}
@@ -6034,7 +6029,7 @@ output_initialize_compound (struct cb_initialize *p, cb_tree x)
 					} else {
 						size = ff->offset + ff->size - last_field->offset;
 					}
-					output_initialize_uniform (c, (unsigned char)last_char, size);
+					output_initialize_uniform (c, last_field, (unsigned char)last_char, size);
 				}
 				break;
 			}
@@ -6161,7 +6156,7 @@ static void
 output_initialize_values_table_format (struct cb_initialize *p)
 {
 	if (needs_table_format_value
-	 && (!p->flag_init_statement || p->val == cb_true)) {
+	 && (p->statement == STMT_INIT_STORAGE || p->val == cb_true)) {
 		struct cb_field		*f = cb_code_field (p->var);
 		const cb_tree		c = cb_build_field_reference (f, NULL);
 		CB_REFERENCE(c)->subs = CB_BUILD_CHAIN (cb_int1, CB_REFERENCE(c)->subs);
@@ -6185,7 +6180,7 @@ output_initialize_values_table_format (struct cb_initialize *p)
 static void
 output_initialize (struct cb_initialize *p)
 {
-	struct cb_field		*f = cb_code_field (p->var);
+	struct cb_field	*f = cb_code_field (p->var);
 	int			c;
 
 	const enum cobc_init_type	type
@@ -6207,15 +6202,15 @@ output_initialize (struct cb_initialize *p)
 	/* TODO: if cb_default_byte >= 0 do a huge memset first, then only
 	         emit setting for fields that need it (VALUE clause or
 	         special category - in general: not matching cb_default_byte);
-	         similar for cb_default_byte == -2 (just without the
-	         initial huge memset) */
+	         similar for cb_default_byte == CB_DEFAULT_BYTE_NONE (-2),
+			 just without the initial huge memset */
 
 	needs_table_format_value = 0;
 
 	/* Check for non-standard OCCURS */
 	if ((f->level == 1 || f->level == 77)
 	 && f->flag_occurs
-	 && !p->flag_init_statement) {
+	 && p->statement == STMT_INIT_STORAGE) {
 		cb_tree			x;
 		switch (type) {
 		case INITIALIZE_ONE:
@@ -6226,7 +6221,7 @@ output_initialize (struct cb_initialize *p)
 		case INITIALIZE_DEFAULT:
 			c = initialize_uniform_char (f, p);
 			if (c != -1) {
-				output_initialize_uniform (p->var, (unsigned char)c, f->occurs_max);
+				output_initialize_uniform (p->var, f, (unsigned char)c, f->size * f->occurs_max);
 				output_initialize_chaining (f, p);
 				return;
 			}
@@ -6271,7 +6266,7 @@ output_initialize (struct cb_initialize *p)
 	case INITIALIZE_DEFAULT:
 		c = initialize_uniform_char (f, p);
 		if (c != -1) {
-			output_initialize_uniform (p->var, (unsigned char)c, f->size);
+			output_initialize_uniform (p->var, f, (unsigned char)c, f->size);
 			output_initialize_chaining (f, p);
 			return;
 		}
@@ -8994,7 +8989,7 @@ output_line_and_trace_info (cb_tree x, const enum cob_statement stmnt)
 	if (  (cb_flag_c_line_directives
 		|| cb_flag_source_location
 		|| cb_cob_line_num)
-	 && x->source_file) {
+	 && x->source_line) {
 		output_cobol_info (x);
 		if (cb_flag_source_location) {
 			output_line ("module->statement = %s;", stmnt_enum);
@@ -9582,7 +9577,8 @@ output_stmt (cb_tree x)
 	}
 	/* LCOV_EXCL_START */
 	if (x == cb_error_node) {
-		cobc_err_msg (_("unexpected error_node parameter"));
+		/* untranslated as unexpected */
+		cobc_err_msg ("unexpected error_node parameter");
 		COBC_ABORT ();
 	}
 	/* LCOV_EXCL_STOP */
@@ -10470,7 +10466,7 @@ output_report_data (struct cb_field *p)
 {
 	if (p->storage == CB_STORAGE_REPORT) {
 		output_emit_field (cb_build_field_reference (p, NULL), NULL);
-		if(p->report_sum_counter) {
+		if (p->report_sum_counter) {
 			output_emit_field (p->report_sum_counter, "SUM");
 		}
 		if (p->report_control) {
@@ -11855,8 +11851,22 @@ output_initial_values (struct cb_field *f)
 		if (p->flag_no_init && !p->count) {
 			continue;
 		}
+		/* note: the initial value of INDEXED BY items is undefined per standard,
+		   but earlier versions always set this explict to 1 on first entry;
+		   we now make this depending on its value, set depending on cb_init_indexed_by
+		   and on cb_implicit_init */
+		if (p->flag_indexed_by && cb_default_byte == CB_DEFAULT_BYTE_NONE) {
+			continue;
+		}
 		x = cb_build_field_reference (p, NULL);
-		output_stmt (cb_build_initialize (x, cb_true, NULL, 1, 0, 0));
+		/* output comment and source location for each 01/77 */
+		output_line ("/* initialize field %s */", p->name);
+		if (cb_flag_c_line_directives && p->common.source_line) {
+			output_cobol_info (CB_TREE (p));
+			output_line ("cob_nop ();");
+			output_c_info ();
+		}
+		output_stmt (cb_build_initialize (x, cb_true, NULL, 1, STMT_INIT_STORAGE, 0));
 		output_newline ();
 	}
 }
@@ -13377,7 +13387,7 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list)
 			}
 			output_line ("%s%d = &%s%d;", CB_PREFIX_DEC_CONST, m->id,
 				     CB_PREFIX_DEC_FIELD, m->id);
-			output_line ("cob_decimal_init(%s%d);", CB_PREFIX_DEC_CONST, m->id);
+			output_line ("cob_decimal_init (%s%d);", CB_PREFIX_DEC_CONST, m->id);
 			output_line ("cob_decimal_set_field (%s%d, (cob_field *)&%s%d);",
 				     CB_PREFIX_DEC_CONST, m->id,
 				     CB_PREFIX_CONST, m->id);

cobc/config.c

@@ -1,5 +1,5 @@
 /*
-   Copyright (C) 2003-2012, 2014-2017, 2019-2022 Free Software Foundation, Inc.
+   Copyright (C) 2003-2012, 2014-2017, 2019-2023 Free Software Foundation, Inc.
    Written by Keisuke Nishida, Roger While, Simon Sobisch
 
    This file is part of GnuCOBOL.
@@ -772,11 +772,11 @@ cb_config_entry (char *buff, const char *fname, const int line)
 		} else if (strcmp (name, "defaultbyte") == 0) {
 			if (strcmp (val, "init") == 0) {
 				/* generate default initialization per INITIALIZE rules */
-				cb_default_byte = -1;
+				cb_default_byte = CB_DEFAULT_BYTE_INIT;
 				break;
 			}
 			if (strcmp (val, "none") == 0) {
-				cb_default_byte = -2;
+				cb_default_byte = CB_DEFAULT_BYTE_NONE;
 #if 1			/* TODO: do not generate any default initialization for fields without VALUE,
 				   only the storage (best performance, least reproducibility); for now warn
 				   if specified on command line (allowing config files be correct already) */
@@ -795,7 +795,7 @@ cb_config_entry (char *buff, const char *fname, const int line)
 			} else
 			/* convert character to number (as quotes will commonly
 			   be removed when given on shell) */
-			if (val[1] == 0 && (val[0] <= '0' || val[0] >= '9')) {
+			if (val[1] == 0 && (val[0] < '0' || val[0] > '9')) {
 				cb_default_byte = val[0];
 				break;
 			}

cobc/field.c

@@ -3220,7 +3220,7 @@ cleanup_field_value (struct cb_field* f, cb_tree *val)
 		}
 		if (*val == cb_zero
 		 && !f->flag_internal_register
-		 && cb_default_byte == -1
+		 && cb_default_byte == CB_DEFAULT_BYTE_INIT
 		 && ( f->storage == CB_STORAGE_WORKING
 		   || f->storage == CB_STORAGE_LOCAL)
 		 && !f->flag_sign_separate) {
@@ -3241,7 +3241,8 @@ cleanup_field_value (struct cb_field* f, cb_tree *val)
 		}
 		if (*val == cb_space
 		 && !f->flag_internal_register
-		 && (cb_default_byte == -1 || cb_default_byte == ' ')
+		 && ( cb_default_byte == CB_DEFAULT_BYTE_INIT
+		   || cb_default_byte == ' ')
 		 && ( f->storage == CB_STORAGE_WORKING
 		   || f->storage == CB_STORAGE_LOCAL)
 		 && !f->children) {