From 3d044db749a5826d90627e70ea3bbfe7ecd92c45 Mon Sep 17 00:00:00 2001
From: ceriel <none@none>
Date: Thu, 9 Jun 1988 11:39:11 +0000
Subject: [PATCH] improved error messages with opaque types

---
 lang/m2/comp/chk_expr.c |  6 +++++-
 lang/m2/comp/typequiv.c | 39 +++++++++++++++++++++------------------
 2 files changed, 26 insertions(+), 19 deletions(-)

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 682da96a1..019ea6fe5 100644
--- a/lang/m2/comp/chk_expr.c
+++ b/lang/m2/comp/chk_expr.c
@@ -892,7 +892,11 @@ ChkBinOper(expp)
 		/* Operands must be compatible (distilled from Def 8.2)
 		*/
 		if (!TstCompat(tpr, tpl)) {
-			return ex_error(expp, "incompatible operand types");
+			extern char *incompat();
+			char buf[128];
+
+			sprint(buf, "%s in operand(s)", incompat(tpl, tpr));
+			return ex_error(expp, buf);
 		}
 
 		MkCoercion(&(expp->nd_left), tpl);
diff --git a/lang/m2/comp/typequiv.c b/lang/m2/comp/typequiv.c
index 8e058ff14..d7dbe640e 100644
--- a/lang/m2/comp/typequiv.c
+++ b/lang/m2/comp/typequiv.c
@@ -160,25 +160,29 @@ TstAssCompat(tp1, tp2)
 	if (tp1->tp_fund == T_ARRAY) {
 		/* check for string
 		*/
-		arith size;
-
 		if (IsConformantArray(tp1)) return 0;
 
-		tp = IndexType(tp1);
-		if (tp->tp_fund == T_SUBRANGE) {
-			size = tp->sub_ub - tp->sub_lb + 1;
-		}
-		else	size = tp->enm_ncst;
-	    	tp1 = BaseType(tp1->arr_elem);
 	    	return
-			tp1 == char_type
-		    &&	(tp2->tp_fund  == T_STRING && size >= tp2->tp_size)
+			BaseType(tp1->arr_elem) == char_type
+		    &&	tp2->tp_fund  == T_STRING
+		    &&  (tp1->arr_high - tp1->arr_low + 1) >= tp2->tp_size
 			;
 	}
 
 	return 0;
 }
 
+char *
+incompat(tp1, tp2)
+	register t_type *tp1, *tp2;
+{
+	
+	if (tp1->tp_fund == T_HIDDEN || tp2->tp_fund == T_HIDDEN) {
+		return "properties of opaque type are hidden; illegal use";
+	}
+	return "type incompatibility";
+}
+
 int
 TstParCompat(parno, formaltype, VARflag, nd, edf)
 	register t_type *formaltype;
@@ -194,7 +198,6 @@ TstParCompat(parno, formaltype, VARflag, nd, edf)
 	*/
 	register t_type *actualtype = (*nd)->nd_type;
 	char ebuf[256];
-	char ebuf1[256];
 
 	if (edf) {
 		sprint(ebuf, "\"%s\", parameter %d: %%s", edf->df_idf->id_text, parno);
@@ -246,19 +249,17 @@ TstParCompat(parno, formaltype, VARflag, nd, edf)
 #ifndef STRICT_3RD_ED
 	if (! options['3'] && VARflag && TstCompat(formaltype, actualtype)) {
 		if (formaltype->tp_size == actualtype->tp_size) {
-			sprint(ebuf1, ebuf, "identical types required");
 			node_warning(*nd,
 				     W_OLDFASHIONED,
-				     ebuf1);
+				     ebuf,
+				     "identical types required");
 			return 1;
 		}
-		sprint(ebuf1, ebuf, "equal sized types required");
-		node_error(*nd, ebuf1);
+		node_error(*nd, ebuf, "equal sized types required");
 		return 0;
 	}
 #endif
-	sprint(ebuf1, ebuf, "type incompatibility");
-	node_error(*nd, ebuf1);
+	node_error(*nd, ebuf, incompat(formaltype, actualtype));
 	return 0;
 }
 
@@ -270,7 +271,9 @@ CompatCheck(nd, tp, message, fc)
 {
 	if (! (*fc)(tp, (*nd)->nd_type)) {
 		if (message) {
-			node_error(*nd, "type incompatibility in %s", message);
+			node_error(*nd, "%s in %s",
+					incompat(tp, (*nd)->nd_type),
+					message);
 		}
 		return 0;
 	}
-- 
2.34.1