improved error messages with opaque types

diff --git a/lang/m2/comp/chk_expr.c b/lang/m2/comp/chk_expr.c
index 682da96..019ea6f 100644 (file)
--- 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 8e058ff..d7dbe64 100644 (file)
--- 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;
        }