Merge remote-tracking branch 'upstream/master' into gc4

NEWS

@@ -365,7 +365,8 @@ Open Plans:
    of internal memory used during CALL; this can help in finding otherwise
    hard to diagnose overwrite of memory and as it is only done on CALL
    has a much smaller footprint than -fec=bounds (as both check different
-   aspects at different places it is also reasonable to use both)
+   aspects at different places it is also reasonable to use both);
+   to disable it use -fmemory-check=none or limit by -fmemory-check=pointer
 
 ** the option -g does no longer imply -fno-remove-unreachable; if you want to
    keep those in you need to explicit specify this
@@ -381,6 +382,9 @@ Open Plans:
 ** adjustments to warning options:
    -Wconstant-expression was changed to a group warning and includes
     the new, previously integrated, -Wconstant-numlit-expression
+   -Wtyping as a new warning raises only very suspicious MOVEs,
+   -Wstrict-typing, which will warn as before even for MOVE 1 TO PICX-FLD
+    is not included in -Wall any more
    -Wlarger-01-redefines as new warning (enabled by -Wextra) to check for
     the only larger REDEFINES that is explicit allowed by the COBOL standard
    -Wno-unsupported -Wunsupported new option to disable or only warn
@@ -393,6 +397,8 @@ Open Plans:
     a coding error
    -Wsuspicious-perform-thru (enabled by default) to check for PERFORM ranges
     that are likely to create unwanted behaviour
+   -Wother now  warns for suspicious reference-modification which is likely to
+    create out-of-bounds access at runtime
 
 ** new compiler command line option to list the known runtime exception names
    and fatality `cobc --list-exceptions`

cobc/ChangeLog

@@ -49,6 +49,28 @@
 	* typeck.c (cb_emit_call): fixed skipping memory-fence generation for
 	  EXTERNAL/BASED sub-fields
 
+2023-07-20  Simon Sobisch <[email protected]>
+
+	* field.c (copy_validation): new function
+	* field.c (copy_validation, copy_into_field): handling validation
+	* cobc.c (print_fields): leave a hint to field being TYPEDEF
+	* cobc.c (xref_fields): dont output references for TYPEDEF sub items
+
+2023-07-19  Simon Sobisch <[email protected]>
+
+	* typeck.c (refmod_checks): extracted from (cb_build_identifier)
+	* typeck.c (refmod_checks): prevent condition-names to be reference-modified
+	* parser.y (class_value): improved error messages
+	* tree.c (cb_build_cast): set numeric category for all integer casts
+
+2023-07-15  Simon Sobisch <[email protected]>
+
+	* typeck.c (cb_build_identifier): allow ref-mod up to identifier length
+	* typeck.c (cb_build_identifier): new warning for suspicious reference-
+	  modification with start or length set to maximum and the other to var
+	* typeck.c (cb_build_move_literal): optimize to cb_build_move_num_zero in
+	  more cases
+
 2023-07-13  Simon Sobisch <[email protected]>
 
 	* pplex.l (cb_ppecho_direct, output_pending_newlines): output only up
@@ -60,6 +82,10 @@
 	* parser.y (emit_statement): changed from define to inline function
 	* codegen.c: complete output of program's end source location if requested
 	* scanner.l: handle line directive in any state
+	* warning.def, typeck.c (validate_move), cobc.c (process_command_line):
+	* use existing -Wstrict-typing only for "strict" type mismatches, including
+	  "same size, different type" and move it to -Wextra; the other mismatches
+	  are still raised with -Wall but under the new -Wtyping
 
 2023-07-11  Fabrice Le Fessant <[email protected]>
 
@@ -238,6 +264,8 @@
 2023-05-30  Simon Sobisch <[email protected]>
 
 	* typeck.y (is_subordinate_to): start with parent, not field
+	* field.c (copy_into_field_recursive, copy_into_field): handling more
+	  field attributes, don't re-build picture
 
 2023-05-28  Simon Sobisch <[email protected]>
 
@@ -248,6 +276,7 @@
 
 	* parser.y, reserved.c: added RIGHTLINE - GC extension matching LEFLINE
 	* parser.y: drop PENDING from OVERLINE and LEFTLINE
+	* tree.c (cb_build_intrinsic): refactored to get the name in a single place
 
 2023-05-24  Simon Sobisch <[email protected]>
 
@@ -280,13 +309,24 @@
 	  literal for use with CONTROL phrase
 	* parser.y: adjust a bunch of terminals to match the internal name with
 	  leading underscore as optional
+	* cobc.c: check for duplicate source file and skip with warning
+	* pplex.l: check for recursive file by resolved file name
+
+2023-05-19  Simon Sobisch <[email protected]>
+
+	* parser.y (usage), field.c (validate_field_1): postpone setting of
+	  field attribute flag_is_pointer from parsing the USAGE clause to final
+	  field validation, fixing group and "child" USAGE, as well as
+	  TYPEDEF + SAME AS with pointer types
 
 2023-05-15  Simon Sobisch <[email protected]>
 
 	* cobc.c (set_category, set_category_from_usage): changed argument types
 	  from int to their matching enum
 	* tree.c (cb_build_prototype), parser.y (setup_prototype),
 	  tree.h (struct cb_prototype): use matching enum
+	* tree.c (cb_field), parser.y, reserved.c: added parsing of GROUP-USAGE
+	* field.c (validate_field_1): handle new attribute group_usage
 
 2023-05-11  Simon Sobisch <[email protected]>
 
@@ -351,6 +391,11 @@
 	* typeck.c (cb_build_move_literal): optimized output for literals to
 	  fields with BLANK WHEN ZERO and SIGN LEADING
 
+2023-05-02  Simon Sobisch <[email protected]>
+
+	* field.c: inclusion of condition-names (level 88) into field that use a
+	  TYPEDEF defintion
+
 2023-04-25  Simon Sobisch <[email protected]>
 
 	* codegen.c (output_so_load_version_check): new function to generate
@@ -583,8 +628,6 @@
 
 2023-01-30  Simon Sobisch <[email protected]>
 
-	* field.c (copy_into_field, copy_into_field_recursive): fix missing set
-	  of flag_is_pointer, fixing TYPEDEF + SAME AS with pointer types
 	* parser.y, reserved.c: add DISPLAY-1 as PENDING,
 	  actually pass NATIONAL usage if specified
 	* field.c (compute_size), tree.c (cb_tree_type): handle CB_USAGE_NATIONAL

cobc/cobc.c

@@ -622,7 +622,7 @@ static void	print_program_header	(void);
 static void	print_program_data	(const char *);
 static void	print_program_trailer	(void);
 static void	print_program_listing	(void);
-static void print_with_overflow (char *, char *);
+static void print_with_overflow (const char *, char *);
 static int	process			(const char *);
 
 /* cobc functions */
@@ -4195,14 +4195,28 @@ process_command_line (const int argc, char **argv)
 #endif
 
 	{
+		enum cb_warn_val check_warn;
+		/* TODO: handle group warnings, likely via option in warning.def */
+
 		/* 3.x compat -Wconstant-expression also sets -Wconstant-numlit-expression */
-		/* TODO: handle group warnings */
-		const enum cb_warn_val detail_warn = get_warn_opt_value (cb_warn_constant_numlit_expr);
-		if (detail_warn != COBC_WARN_DISABLED_EXPL
-		 && detail_warn != COBC_WARN_ENABLED_EXPL) {
+		check_warn = get_warn_opt_value (cb_warn_constant_numlit_expr);
+		if (check_warn != COBC_WARN_DISABLED_EXPL
+		 && check_warn != COBC_WARN_ENABLED_EXPL) {
 			const enum cb_warn_val group_warn = get_warn_opt_value (cb_warn_constant_expr);
 			set_warn_opt_value (cb_warn_constant_numlit_expr, group_warn);
 		}
+		/* group with different main group: -Wstrict-typing (a -Wextra one) implies -Wtyping,
+		   (a -Wall one), and -Wno-typing implies -Wno-strict-typing */
+		check_warn = get_warn_opt_value (cb_warn_strict_typing);
+		if (check_warn == COBC_WARN_ENABLED_EXPL) {
+			set_warn_opt_value (cb_warn_typing, COBC_WARN_ENABLED_EXPL);
+		} else {
+			const enum cb_warn_val warn_type = get_warn_opt_value (cb_warn_typing);
+			if (warn_type == COBC_WARN_DISABLED_EXPL) {
+				set_warn_opt_value (cb_warn_strict_typing, COBC_WARN_DISABLED_EXPL);
+			}
+		}
+
 		/* set all explicit warning options to their later checked variants */
 #define CB_CHECK_WARNING(opt)  \
 		if (get_warn_opt_value (opt) == COBC_WARN_ENABLED_EXPL) {	\
@@ -5779,6 +5793,7 @@ print_88_values (struct cb_field *field)
 			"      %-14.14s %02d   %s",
 			"CONDITIONAL", f->level, f->name);
 		print_program_data (print_data);
+		/* CHECKME: Would it be useful or noise to print 88er values here? */
 	}
 }
 
@@ -5838,7 +5853,14 @@ print_fields (struct cb_field *top, int *found)
 			pd_off = sprintf (print_data, "%05d ", top->size);
 		}
 
-		pd_off += sprintf (print_data + pd_off, "%-14.14s %02d   ", type, top->level);
+		if (top->flag_is_typedef) {
+			/* at least leave a hint on the TYPEDEF in symbol listing,
+			   note: for "ALPHANUMERIC" we have only 2 positions left, so "T " */
+			pd_off += sprintf (print_data + pd_off, "T %-12.12s ", type);
+		} else {
+			pd_off += sprintf (print_data + pd_off, "%-14.14s ", type);
+		}
+		pd_off += sprintf (print_data + pd_off, "%02d   ", top->level);
 
 		name_or_filler = check_filler_name (top);
 		if (got_picture) {
@@ -6158,6 +6180,12 @@ xref_fields (struct cb_field *top)
 			xref_print (&top->xref, XREF_FIELD, NULL);
 		}
 
+		/* enough, if we are a typedef, as its contents are only
+		   referenced through fields using this type */
+		if (top->flag_is_typedef) {
+			continue;
+		}
+
 		/* print xref for all assigned 88 validation entries */
 		if (top->validation) {
 			xref_88_values (top);
@@ -6402,7 +6430,7 @@ print_program_trailer (void)
 		cmd_line[pd_off - 1] = 0;
 		force_new_page_for_next_line ();
 		print_program_data (_("command line:"));
-		print_with_overflow ((char *)"  ", cmd_line);
+		print_with_overflow ("  ", cmd_line);
 		print_break = 0;
 	} else {
 		print_program_data ("");
@@ -6675,13 +6703,14 @@ line_has_listing_directive (char *line, const enum cb_format source_format, int
 
 	token = get_directive_start (line, source_format);
 
-	if (token != NULL &&
-		!strncasecmp (token, "LISTING", 7)) {
+	if (token != NULL
+	 && !strncasecmp (token, "LISTING", 7)) {
 		token += 7;
 		*on_off = 1;
 		token = get_next_nonspace (token);
-		if (!strncasecmp (token, "OFF", 3))
+		if (!strncasecmp (token, "OFF", 3)) {
 			*on_off = 0;
+		}
 		return 1;
 	}
 	return 0;
@@ -6842,7 +6871,7 @@ print_free_line (const int line_num, char pch, char *line)
 }
 
 static void
-print_with_overflow (char *prefix, char *content)
+print_with_overflow (const char *prefix, char *content)
 {
 	const unsigned int	max_chars_on_line = cb_listing_wide ? 120 : 80;
 	int offset;

cobc/codeoptim.c

@@ -172,10 +172,10 @@ cob_gen_optim (const enum cb_optim val)
 		output_storage ("	const int minimal_length = zero_allowed ? 0 : 1;");
 		output_storage ("	if (offset < 1 || length < minimal_length");
 		output_storage ("	 || offset + length - 1 > size) {");
-		output_storage ("		cob_check_ref_mod (name, abend, zero_allowed, size, offset, length);");
+		output_storage ("		cob_check_ref_mod_detailed (name, abend, zero_allowed, size, offset, length);");
 		output_storage ("	}");
 		output_storage ("}");
-		output_storage ("#define cob_check_ref_mod" "\t" "cob_check_ref_mod_inline");
+		output_storage ("#define cob_check_ref_mod_detailed" "\t" "cob_check_ref_mod_inline");
 		return;
 
 	case COB_CHK_REFMOD_MIN:

cobc/field.c

@@ -714,6 +714,33 @@ copy_duplicated_field_into_field (struct cb_field *field, struct cb_field *targe
 	copy_into_field_recursive (field, CB_FIELD (x), outer_indexes);
 }
 
+static void
+copy_validation (struct cb_field *source, struct cb_field *target)
+{
+	struct cb_field *val, *last_val;
+#if 0 /* in case we want to allow combining condition-names of typedef and field */
+	for (last_val = target->validation; last_val; last_val = last_val->sister) {
+		/* get to the last validation entry*/
+		if (!last_val->sister) {
+			break;
+		}
+	}
+#else
+	if (target->validation) {
+		(void) cb_syntax_check_x (CB_TREE (target->validation), _("duplicate %s"), "level  88");
+	}
+#endif
+	for (val = source->validation; val; val = val->sister) {
+		/* create content-name and link into the reference list */
+		cb_tree x = cb_build_field_tree (88, cb_build_reference (val->name),
+			target, target->storage, target->file, 0);
+		last_val = CB_FIELD (x);
+		/* directly assign the typef's value + false (no need for copy) */
+		last_val->values = val->values;
+		last_val->false_88 = val->false_88;
+	}
+}
+
 static void
 copy_children (struct cb_field *child, struct cb_field *target,
 	const int level, const int outer_indexes, const enum cb_storage storage)
@@ -813,10 +840,12 @@ copy_into_field_recursive (struct cb_field *source, struct cb_field *target,
 	field_attribute_override (flag_sign_leading);
 	field_attribute_override (flag_sign_separate);
 	field_attribute_override (flag_synchronized);
-	field_attribute_override (flag_item_based);
+	field_attribute_override (flag_sync_right);
+	field_attribute_override (flag_sync_left);
 	field_attribute_override (flag_any_length);
 	field_attribute_override (flag_any_numeric);
 	field_attribute_override (flag_invalid);
+	field_attribute_override (flag_item_based);
 	field_attribute_override (flag_is_pointer);
 	/* Note: attributes must be handled both here and in copy_into_field */
 
@@ -827,10 +856,18 @@ copy_into_field_recursive (struct cb_field *source, struct cb_field *target,
 		target->redefines = cb_resolve_redefines (target, ref);
 	}
 
+	/* copy all level 88 */
+	if (source->validation) {
+		copy_validation (source, target);
+	}
+
 	if (source->children) {
 		copy_children (source->children, target, target->level, outer_indexes, target->storage);
 	} else if (source->pic){
-		target->pic = cb_build_picture (source->pic->orig);
+		/* take over internal PICTURE representation as-is, no use in re-building
+		   that from scratch and handle calculated ->pic special */
+		target->pic = cobc_parse_malloc (sizeof (struct cb_picture));
+		memcpy (target->pic, source->pic, sizeof (struct cb_picture));
 	}
 
 	if (source->sister) {
@@ -859,7 +896,8 @@ copy_into_field (struct cb_field *source, struct cb_field *target)
 #endif
 
 	/* note: EXTERNAL is always applied from the typedef (if level 1/77),
-			 but may be specified on the field */
+			 but may be specified on the field;
+	   note: MF has different syntax rules and _only_ allows it on the field */
 	if (target->level == 1 || target->level == 77) {
 		field_attribute_copy (flag_external);
 		if (target->flag_external
@@ -872,10 +910,15 @@ copy_into_field (struct cb_field *source, struct cb_field *target)
 		}
 	}
 	target->usage = source->usage;
+	target->common.category = source->common.category;
 	if (target->flag_external
 	 && target->ename == NULL) {	/* External Name is required */
 		target->ename = target->name;
-	}    
+	}
+
+	/* Note: The attributes GLOBAL and SELECT WHEN are never included;
+	         SAME AS does not include EXTERNAL, but the TYPEDEF  */
+
 	if (source->values) {
 		if (target->values) {
 			duplicate_clause_message (target->values, "VALUE");
@@ -888,19 +931,32 @@ copy_into_field (struct cb_field *source, struct cb_field *target)
 	field_attribute_copy (flag_sign_clause);
 	field_attribute_copy (flag_sign_leading);
 	field_attribute_copy (flag_sign_separate);
-	field_attribute_copy (flag_synchronized);
-	field_attribute_copy (flag_item_based);
+	if (source->flag_synchronized
+	 && !target->flag_synchronized) {
+		target->flag_synchronized = source->flag_synchronized;
+		target->flag_sync_right = source->flag_sync_right;
+		target->flag_sync_left = source->flag_sync_left;
+	}	
 	field_attribute_override (flag_any_length);
 	field_attribute_override (flag_any_numeric);
 	field_attribute_override (flag_invalid);
+	field_attribute_copy (flag_item_based);
 	field_attribute_override (flag_is_pointer);
 	/* Note: attributes must be handled both here and in copy_into_field_recursive */
 
+	/* copy all level 88 */
+	if (source->validation) {
+		copy_validation (source, target);
+	}
+
 	if (!target->like_modifier) {
 		if (source->children) {
 			copy_children (source->children, target, target->level, target->indexes, target->storage);
 		} else if (source->pic) {
-			target->pic = cb_build_picture (source->pic->orig);
+			/* take over internal PICTURE representation as-is, no use in re-building
+			   that from scratch and in handling calculated ->pic special */
+			target->pic = cobc_parse_malloc (sizeof (struct cb_picture));
+			memcpy (target->pic, source->pic, sizeof (struct cb_picture));
 		}
 	} else {
 		struct cb_picture *new_pic = NULL;
@@ -971,6 +1027,7 @@ copy_into_field (struct cb_field *source, struct cb_field *target)
 		if (new_pic) {
 			target->pic = new_pic;
 		} else if (target->pic) {
+			/* CHECKME: is there any use in re-building the PIC? */
 			target->pic = cb_build_picture (target->pic->orig);
 		}
 	}