Merge SVN 4795

cobc/ChangeLog

@@ -78,6 +78,15 @@
 
 	* parser.y, tree.c (cb_build_vary), tree.h: cleanup to not use
 	  static variables in the parser for creation of the rw vary items
+	* parser.y, reserved.c: full parsing for COBOL2002 and BS2000
+	  multi VALUE entries via VALUES [ARE]
+	* parser.y, field.c, tree.h, codegen.c, tree.c, scanner.l: new struct
+	  cb_table_values to store the complex parsing result, only embed the VALUE
+	  in a list when actually necessary, and use these adjustments in syntax
+	  and codegen
+	* field.c: check all multi-values for correct type an length;
+	  verify that only up to max amount entries are specified;
+	  TODO: complete handling of FROM/TO/REPEATED clause
 
 2022-10-19  Simon Sobisch <[email protected]>
 

cobc/codegen.c

@@ -823,14 +823,15 @@ static int
 chk_field_multi_values (struct cb_field *f)
 {
 	struct cb_field		*fc;
+
 	if (f->values
-	 && CB_CHAIN (f->values)) {
+	 && CB_LIST_P (f->values)) {
+	 	/* multi-value entry */
 		return 1;
 	}
-	if (f->values
-	 && CB_VALUE (f->values)) {
-		 if (CB_LITERAL_P (CB_VALUE(f->values))
-		  && CB_LITERAL (CB_VALUE(f->values))->all) {
+	if (f->values) {
+		 if (CB_LITERAL_P (f->values)
+		  && CB_LITERAL (f->values)->all) {
 			return 1;
 		}
 		if (f->flag_occurs) {
@@ -5625,7 +5626,20 @@ output_initialize_one (struct cb_initialize *p, cb_tree x)
 
 	/* Initialize by value */
 	if (p->val && f->values) {
-		value = CB_VALUE (f->values);
+		if (!CB_LIST_P (f->values)) {
+			/* common case: simple VALUE */
+			value = f->values;
+		} else {
+			/* multiple VALUE, either from report-format
+			   or from the complex table-format;
+			   get the first one here */
+			value = CB_VALUE (f->values);
+			if (CB_TAB_VALS_P (value)) {
+				/* get the first entry of many */
+				value = CB_TAB_VALS (value)->values;
+				value = CB_VALUE (value);
+			}
+		}
 		/* Check for non-standard OCCURS */
 		if ((f->level == 1 || f->level == 77)
 		 && f->flag_occurs && !p->flag_init_statement) {
@@ -5971,19 +5985,19 @@ output_initialize_occurs (struct cb_initialize *p, cb_tree x)
 		idx_stop = 0;
 		offset = f->offset;
 		list = f->values;
-		/* TODO: move check to parser and translate msgid */
-		k = cb_list_length (f->values) - total_occurs;
-		if (k > 0) {
-			cb_error_x ((cb_tree)f, "%s has %d more value%s than needed",
-							f->name,k,k>1?"s":"");
-			return;
-		}
 		l = list;
 		while (!idx_stop) {
 			pf = pftbl[0];
 			pf->flag_occurs = 0;
 			pf->occurs_max = 0;
-			if (list && CB_CHAIN (list)) {	/* Multiple VALUEs present */
+			if (list && CB_LIST_P (list)) {	/* Multiple VALUEs present */
+				l = CB_VALUE (list);
+				if (CB_TAB_VALS_P (l)) {
+					/* FIXME: handle FROM TO/REPEATED */
+					l = CB_TAB_VALS (l)->values;
+				} else {
+					l = list;
+				}
 				for (idx_clr = 0; l && !idx_stop; idx_clr++, l = CB_CHAIN (l)) {
 					f->values = l;
 					f->offset = get_table_offset ( offset, idx, idxtbl, occtbl, pftbl);
@@ -6194,8 +6208,6 @@ output_initialize (struct cb_initialize *p)
 	 && !p->flag_init_statement) {
 		cb_tree			x;
 		switch (type) {
-		case INITIALIZE_NONE:
-			return;
 		case INITIALIZE_ONE:
 			output_initialize_occurs (p, p->var);
 			output_initialize_chaining (f, p);
@@ -6238,8 +6250,6 @@ output_initialize (struct cb_initialize *p)
 		output_newline ();
 	}
 	switch (type) {
-	case INITIALIZE_NONE:
-		return;
 	case INITIALIZE_ONE:
 		output_initialize_occurs (p, p->var);
 		output_initialize_chaining (f, p);
@@ -10679,11 +10689,25 @@ output_report_one_field (struct cb_report *r, struct cb_field *f, int idx, int o
 			} else {
 				value = CB_VALUE (f->values);
 			}
+
+/*
+		if (field_val) {
+			value = field_val;
+			if (CB_LIST_P (value)) {
+				field_val = CB_CHAIN (field_val);
+				/ * CHECKME: we get here with an _actual_ list in RW case
+				   but drop all entries but the first one... * /
+				value = CB_VALUE (value); // is literal (tag 8)
+				if (CB_TAB_VALS_P (value)) {
+					value = CB_TAB_VALS (value)->values;
+					value = CB_VALUE (value);
+				}
+			}
+*/
 		} else if (f->report_source
 			  && CB_LITERAL_P (f->report_source)) {
 			value = f->report_source;
 		}
-
 		if (value
 		 && CB_TREE_TAG (value) == CB_TAG_LITERAL) {
 			char	*val, *out;
@@ -11855,12 +11879,6 @@ output_module_register_init (cb_tree reg, const char *name)
 		return;
 	}
 
-	/* LCOV_EXCL_START */
-	if (!CB_REF_OR_FIELD_P (reg)) {
-		CB_TREE_TAG_UNEXPECTED_ABORT (reg);
-	}
-	/* LCOV_EXCL_STOP */
-
 	if (CB_REFERENCE_P (reg)) {
 		reg = cb_ref (reg);
 		if (CB_FIELD_P (reg) && !CB_FIELD (reg)->count) {