fixing [bugs:#643] missing check for target of SET

cobc/typeck.c (validate_move): add check for SET literal TO value

cobc/ChangeLog

@@ -1,10 +1,14 @@
 
+2022-12-14  Simon Sobisch <[email protected]>
+
+	* typeck.c (validate_move): fix bug #643 add check for SET literal TO val
+
 2022-12-13  Simon Sobisch <[email protected]>
 
 	* cobc.c (cb_warn_opt_val, get_warn_opt_value, set_warn_opt_value), cobc.h:
 	  renamed cb_warn_opt_val to warn_opt_val and keep local, provide typed
-	  functions to get/set the internal option with the "real" type for improved
-	  type checks and internal cobc debugging
+	  functions to get/set the internal option with the "real" type for
+	  improved type checks and internal cobc debugging
 	* cobc.c, error.c, field.c, parser.y, pplex.l, tree.c, typeck.c: adjusted
 	  to use new get_warn_opt_value / set_warn_opt_value functions
 	* codegen.c (output_index): fix bug #832 binary-char unsigned not usable

cobc/typeck.c

@@ -10398,6 +10398,8 @@ validate_move (cb_tree src, cb_tree dst, const unsigned int is_value, int *move_
 	int			most_significant;
 	int			least_significant;
 
+	/* CHECKME: most of the "invalid" checks should possibly be handled in the parser */
+
 	loc = src->source_line ? src : dst;
 	is_numeric_edited = 0;
 	overlapping = 0;
@@ -10406,16 +10408,13 @@ validate_move (cb_tree src, cb_tree dst, const unsigned int is_value, int *move_
 	}
 	*move_zero = 0;
 	if (CB_REFERENCE_P (dst)) {
-		cb_tree dstr = CB_REFERENCE(dst)->value;
-		if (CB_ALPHABET_NAME_P(dstr)
+		cb_tree dstr = CB_REFERENCE (dst)->value;
+		if (CB_ALPHABET_NAME_P (dstr)
+		 || CB_CONST_P (dstr)
 		 || CB_FILE_P (dstr)) {
 			goto invalid;
 		}
 	}
-	if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_BOOLEAN) {
-		cb_error_x (loc, _("invalid destination for MOVE"));
-		return -1;
-	}
 
 	if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER) {
 		if (CB_TREE_CLASS (src) == CB_CLASS_POINTER) {
@@ -10429,6 +10428,11 @@ validate_move (cb_tree src, cb_tree dst, const unsigned int is_value, int *move_
 		}
 	}
 
+	if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_BOOLEAN
+	 || CB_LITERAL_P (dst)) {
+		goto invalid;
+	}
+
 	fdst = CB_FIELD_PTR (dst);
 	if (fdst->flag_internal_constant || fdst->flag_constant) {
 		goto invalid;

tests/testsuite.src/syn_move.at

@@ -535,6 +535,8 @@ AT_DATA([prog.cob], [
       *> see bug #255 and an internal compiler error, see bug #295:
            set address of float-var to default-float
            set no-pointer to address of default-float
+      *> previously raised internal compiler error, see bug #643:
+           set 1 to no-pointer
       *> all fine...
            set address of float-var to address of default-float
            goback.
@@ -544,6 +546,7 @@ AT_DATA([prog.cob], [
 AT_CHECK([$COMPILE_ONLY prog.cob], [1], [],
 [prog.cob:14: error: invalid SET statement
 prog.cob:15: error: invalid SET statement
+prog.cob:17: error: invalid SET statement
 ])
 
 AT_CLEANUP