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

Author: ddeclerck

TODO

@@ -210,6 +210,8 @@ https://sourceforge.net/p/gnucobol/code/HEAD/tree/external-doc/guide/
 
 - Rework the context-sensitive reserved words handling (or use a bigger type)
 
+- Replace checks for statement that still use cobc_cs_check to [current_}statement->statement
+
 - Add --error-list -e to cobc
 
 - Check how to deal with IMPEXP in coblocal.h (should probably be in the "lib" directory as a static library to link with the other libraries)

cobc/ChangeLog

@@ -1,4 +1,9 @@
 
+2025-05-21  David Declerck <[email protected]>
+
+	revert 2018-07-31 changes preferring normalization of
+	numeric DISPLAY data including 0x00
+
 2025-05-21  David Declerck <[email protected]>
 
 	* cobc.c: fix duplicate values for CB_FLAG_GETOPT_GENTABLE
@@ -163,6 +168,20 @@
 	* typeck.c (cb_emit, cb_emit_list): changed from defines to inline
 	  functions, now returning the tree that was emitted
 
+2024-07-29  Chuck Haatvedt <[email protected]>
+
+	* tree.c (cb_build_picture): added logic to find the valid floating
+	  symbol if one exists and pass that symbol to the downstream functions
+	* tree.c (valid_char_order): adjust the precedence in an ambigous
+	  where +$9 or 9$+ to identify the condition of the $ correctly
+	  to fix bug #935
+	* tree.c (find_floating_insertion_str): generate a compile error
+	  if an invalid symbol is found between the float symbols; this also
+	  allows the COBOL 2023 standard to be more closely followed for
+	  display numeric edited picture strings
+	* tree.c (char_to_precedence_idx): changed to check penultimate and last
+	  symbols before the first and second symbols
+
 2024-07-26  Simon Sobisch <[email protected]>
 
 	* parser.y, config.def: rewrite ENVIRONMENT DIVISION parsing to allow
@@ -171,10 +190,18 @@
 	* reserved.c: make MENU context-sensitive
 	* reserved.c, parser.y: added MODAL + MODELESS to acu extension windows
 
+2024-07-10  Chuck Haatvedt <[email protected]>
+
+	* tree.c (cb_build_picture): fixed currency scale counting logic
+
 2024-06-19  David Declerck <[email protected]>
 
 	* cobc.c (process_compile): fix MSVC build command
 
+2024-06-11  Chuck Haatvedt <[email protected]>
+
+	* tree.c (cb_build_picture): fixed currency digit counting logic
+
 2024-05-16  David Declerck <[email protected]>
 
 	* cobc.c (process_compile)[_MSC_VER]: adjustment for compile

cobc/field.c

@@ -2269,6 +2269,7 @@ static unsigned int
 validate_elementary_item (struct cb_field *f)
 {
 	unsigned int	ret;
+	cb_tree		x;
 
 	ret = validate_usage (f);
 	if (f->flag_sign_clause) {
@@ -2294,6 +2295,7 @@ validate_elementary_item (struct cb_field *f)
 	ret |= validate_pic (f);
 
 	/* TODO: This is not validation and should be elsewhere. */
+	x = CB_TREE (f);
 	switch (f->usage) {
 	case CB_USAGE_DISPLAY:
 		if (current_program
@@ -2308,36 +2310,43 @@ validate_elementary_item (struct cb_field *f)
 		f->usage = CB_USAGE_COMP_5;
 		f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 1);
 		f->flag_real_binary = 1;
+		validate_field_clauses (x, f);
 		break;
 	case CB_USAGE_SIGNED_SHORT:
 		f->usage = CB_USAGE_COMP_5;
 		f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 1);
 		f->flag_real_binary = 1;
+		validate_field_clauses (x, f);
 		break;
 	case CB_USAGE_SIGNED_INT:
 		f->usage = CB_USAGE_COMP_5;
 		f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 1);
 		f->flag_real_binary = 1;
+		validate_field_clauses (x, f);
 		break;
 	case CB_USAGE_SIGNED_LONG:
 		f->usage = CB_USAGE_COMP_5;
 		f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 1);
 		f->flag_real_binary = 1;
+		validate_field_clauses (x, f);
 		break;
 	case CB_USAGE_UNSIGNED_CHAR:
 		f->usage = CB_USAGE_COMP_5;
 		f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 0);
 		f->flag_real_binary = 1;
+		validate_field_clauses (x, f);
 		break;
 	case CB_USAGE_UNSIGNED_SHORT:
 		f->usage = CB_USAGE_COMP_5;
 		f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 0);
 		f->flag_real_binary = 1;
+		validate_field_clauses (x, f);
 		break;
 	case CB_USAGE_UNSIGNED_INT:
 		f->usage = CB_USAGE_COMP_5;
 		f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 0);
 		f->flag_real_binary = 1;
+		validate_field_clauses (x, f);
 		break;
 	case CB_USAGE_POINTER:
 		if (cb_numeric_pointer) {
@@ -2349,6 +2358,7 @@ validate_elementary_item (struct cb_field *f)
 		f->usage = CB_USAGE_COMP_5;
 		f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 0);
 		f->flag_real_binary = 1;
+		validate_field_clauses (x, f);
 		break;
 	default:
 		break;
@@ -2358,7 +2368,6 @@ validate_elementary_item (struct cb_field *f)
 	if (f->flag_blank_zero
 	 && f->pic
 	 && f->pic->category == CB_CATEGORY_NUMERIC) {
-		cb_tree x;
 		cob_pic_symbol	*pstr = NULL;
 		int		n = 0;
 		/* Reconstruct the picture string */
@@ -2377,74 +2386,6 @@ validate_elementary_item (struct cb_field *f)
 				pstr->times_repeated = 1;
 				++pstr;
 			}
-		}
-		x = CB_TREE (f);
-
-		switch (f->usage) {
-		default:
-			break;
-		case CB_USAGE_DISPLAY:
-			if (current_program->flag_trailing_separate
-			 && f->pic
-			 && f->pic->category == CB_CATEGORY_NUMERIC
-			 && !f->flag_sign_leading) {
-				f->flag_sign_separate = 1;
-			}
-			break;
-		case CB_USAGE_SIGNED_CHAR:
-			f->usage = CB_USAGE_COMP_5;
-			f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 1);
-			f->flag_real_binary = 1;
-			validate_field_clauses (x, f);
-			break;
-		case CB_USAGE_SIGNED_SHORT:
-			f->usage = CB_USAGE_COMP_5;
-			f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 1);
-			f->flag_real_binary = 1;
-			validate_field_clauses (x, f);
-			break;
-		case CB_USAGE_SIGNED_INT:
-			f->usage = CB_USAGE_COMP_5;
-			f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 1);
-			f->flag_real_binary = 1;
-			validate_field_clauses (x, f);
-			break;
-		case CB_USAGE_SIGNED_LONG:
-			f->usage = CB_USAGE_COMP_5;
-			f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 1);
-			f->flag_real_binary = 1;
-			validate_field_clauses (x, f);
-			break;
-		case CB_USAGE_UNSIGNED_CHAR:
-			f->usage = CB_USAGE_COMP_5;
-			f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 0);
-			f->flag_real_binary = 1;
-			validate_field_clauses (x, f);
-			break;
-		case CB_USAGE_UNSIGNED_SHORT:
-			f->usage = CB_USAGE_COMP_5;
-			f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 0);
-			f->flag_real_binary = 1;
-			validate_field_clauses (x, f);
-			break;
-		case CB_USAGE_UNSIGNED_INT:
-			f->usage = CB_USAGE_COMP_5;
-			f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 0);
-			f->flag_real_binary = 1;
-			validate_field_clauses (x, f);
-			break;
-		case CB_USAGE_UNSIGNED_LONG:
-			f->usage = CB_USAGE_COMP_5;
-			f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 0);
-			f->flag_real_binary = 1;
-			validate_field_clauses (x, f);
-			break;
-		case CB_USAGE_BINARY:
-		case CB_USAGE_PACKED:
-		case CB_USAGE_BIT:
-			if (f->pic->category != CB_CATEGORY_NUMERIC) {
-				cb_error_x (x, _("'%s' PICTURE clause not compatible with USAGE"), cb_name (x));
-			}
 			pstr->symbol = '9';
 			pstr->times_repeated = (int)f->pic->digits - f->pic->scale;
 			++pstr;
@@ -2457,7 +2398,22 @@ validate_elementary_item (struct cb_field *f)
 			++pstr;
 
 			f->pic->size++;
-			break;
+		} else {
+			/* Size for genned string */
+			if (f->pic->have_sign) {
+				n = 2;
+			} else {
+				n = 1;
+		}
+			f->pic->str = cobc_parse_malloc ((size_t)n * sizeof(cob_pic_symbol));
+			pstr = f->pic->str;
+			if (f->pic->have_sign) {
+				pstr->symbol = '+';
+				pstr->times_repeated = 1;
+				++pstr;
+		}
+			pstr->symbol = '9';
+			pstr->times_repeated = f->pic->digits;
 		}
 		f->pic->lenstr = n;
 		f->pic->category = CB_CATEGORY_NUMERIC_EDITED;