Source for version 1.3.11 of 1 April 2011

New diagnostic for unresolved opaque types when using /perwapi option.
However, this version tries to resolve imported opaques by creating a matching ClassRef.

gpcp/CPascal.cp

@@ -190,9 +190,9 @@ MODULE CPascal;
       *  be called twice. Avoid an attempted sharing violation...
       *)
       IF Scnr.lst # NIL THEN 
-      TxtFil.CloseFile(Scnr.lst);
-      CSt.Message(RTS.getStr(sysX));
-      Scnr.lst := NIL;
+        TxtFil.CloseFile(Scnr.lst);
+        CSt.Message(RTS.getStr(sysX));
+        Scnr.lst := NIL;
       ELSE
         FixListing;
       END;

gpcp/CPascalErrors.cp

@@ -506,6 +506,7 @@ MODULE CPascalErrors;
     | 233: str := "Literal constant too big, even for LONGINT";
     | 234: str := "Extension of LIMITED type must be limited";
     | 235: str := "LIMITED types can only be extended in the same module";
+    | 236: str := "Cannot resolve CLR name of this type";
 
     | 298: str := "ILASM failed to assemble IL file";
     | 299: str := "Compiler raised an internal exception";
@@ -617,6 +618,8 @@ MODULE CPascalErrors;
     | 205,
       207: msg := LitValue.strToCharOpen(
 		       "Binding scope of feature is record type <" + s1 + ">");
+    | 236: msg := LitValue.strToCharOpen(
+                       "Cannot resolve CLR name of type : " + s1);
     | 299: msg := LitValue.strToCharOpen("Exception: " + s1);
     | 308: msg := LitValue.strToCharOpen(
                        "Renaming static class to <" + s1 + ">");

gpcp/GPCPcopyright.cp

@@ -42,7 +42,8 @@ MODULE GPCPcopyright;
      (* VERSION    = "1.3.6 of 1 September 2007"; *)
      (* VERSION    = "1.3.8 of 18 November 2007"; *)
      (* VERSION    = "1.3.9 of 15 January 2008"; *)
-        VERSION    = "1.3.10 of 15 November 2010";
+     (* VERSION    = "1.3.10 of 15 November 2010"; *)
+        VERSION    = "1.3.11 of 1 April 2011";
 	verStr*    = " version " + VERSION;
 
   CONST	prefix     = "#gpcp: ";

gpcp/MsilUtil.cp

@@ -941,7 +941,8 @@ MODULE MsilUtil;
     elTp := arTp.elemTp;
     aLen := arTp.length;
     os.PushInt(aLen);
-    os.CodeTn(Asm.opc_newarr, elTp);
+   (* os.CodeTn(Asm.opc_newarr, elTp); *)
+    os.CodeT(Asm.opc_newarr, elTp);
    (*
     *   Do we need an initialization loop?
     *)
@@ -990,7 +991,8 @@ MODULE MsilUtil;
         vTp : Sy.Type;
   BEGIN
     ord := mapVecElTp(eTp);
-    os.CodeTn(Asm.opc_newarr, mapOrdRepT(ord));
+    (*os.CodeTn(Asm.opc_newarr, mapOrdRepT(ord)); *)
+    os.CodeT(Asm.opc_newarr, mapOrdRepT(ord));
     os.PutGetF(Asm.opc_stfld, vecArray(ord));
   END MkVecArr;
 
@@ -1054,7 +1056,8 @@ MODULE MsilUtil;
               os.MkFixedArray(elT);
             ELSE
               os.PushLocal(lAr[dim+1]);
-              os.CodeTn(Asm.opc_newarr, elT.elemTp);
+              (*os.CodeTn(Asm.opc_newarr, elT.elemTp); *)
+              os.CodeT(Asm.opc_newarr, elT.elemTp);
               InitLoop(os, dim+1, elT, lAr);
             END;
         END;
@@ -1081,10 +1084,12 @@ MODULE MsilUtil;
     IF (elTp IS Ty.Array) OR (elTp IS Ty.Record) THEN
       GetLengths(os, 0, arTp, lens);
       os.PushLocal(lens[0]);
-      os.CodeTn(Asm.opc_newarr, elTp);
+      (*os.CodeTn(Asm.opc_newarr, elTp); *)
+      os.CodeT(Asm.opc_newarr, elTp);
       InitLoop(os, 0, arTp, lens);
     ELSE
-      os.CodeTn(Asm.opc_newarr, elTp);
+      (*os.CodeTn(Asm.opc_newarr, elTp); *)
+      os.CodeT(Asm.opc_newarr, elTp);
     END; 
   END MkOpenArray;
 
@@ -1333,6 +1338,7 @@ MODULE MsilUtil;
       IF inS[0] # '[' THEN 
         RETURN mod.clsNm;
       ELSE
+        INCL(mod.xAttr, Sy.isFn); (* make sure this is marked foreign *)
         ln := LEN(inS);
         ix := 0;
         REPEAT

gpcp/PeUtil.cp

@@ -2435,13 +2435,35 @@ MODULE PeUtil;
     RETURN rTy.tgXtn(RecXtn).vDlr;
   END vDl;
 
+(* -------------------------------- *)
+
+  PROCEDURE (os : PeFile)RescueOpaque(tTy : Sy.Type),NEW;
+    VAR blk : Id.BlkId;
+        ext : BlkXtn;
+  BEGIN
+    blk := tTy.idnt.dfScp(Id.BlkId);
+    os.DoExtern(blk);
+    ext := blk.tgXtn(BlkXtn);
+    (* Set tgXtn to a ClassRef *)
+    tTy.tgXtn := getOrAddClass(ext.asmD, MKSTR(blk.xName^), MKSTR(Sy.getName.ChPtr(tTy.idnt)^));
+  RESCUE (any)
+    (* Just leave tgXtn = NIL *)
+  END RescueOpaque;
+
 (* -------------------------------- *)
 
   PROCEDURE (os : PeFile)typ(tTy : Sy.Type) : Api.Type,NEW;
     VAR xtn : ANYPTR;
   BEGIN (* returns Api.Type descriptor for this type *)
     IF tTy.tgXtn = NIL THEN Mu.MkTypeName(tTy, os) END;
+    IF (tTy IS TypeDesc.Opaque) & (tTy.tgXtn = NIL) THEN os.RescueOpaque(tTy(TypeDesc.Opaque)) END;
     xtn := tTy.tgXtn;
+    IF xtn = NIL THEN 
+      IF tTy.xName # NIL THEN tTy.TypeErrStr(236, tTy.xName); 
+      ELSE tTy.TypeError(236); 
+      END;
+      RTS.Throw("Opaque Type Error");
+    END;
     WITH xtn : Api.Type DO
         RETURN xtn;
     | xtn : RecXtn DO

gpcp/PeUtilForNET.cp

@@ -2435,13 +2435,35 @@ MODULE PeUtil;
     RETURN rTy.tgXtn(RecXtn).vDlr;
   END vDl;
 
+(* -------------------------------- *)
+
+  PROCEDURE (os : PeFile)RescueOpaque(tTy : Sy.Type),NEW;
+    VAR blk : Id.BlkId;
+        ext : BlkXtn;
+  BEGIN
+    blk := tTy.idnt.dfScp(Id.BlkId);
+    os.DoExtern(blk);
+    ext := blk.tgXtn(BlkXtn);
+    (* Set tgXtn to a ClassRef *)
+    tTy.tgXtn := getOrAddClass(ext.asmD, MKSTR(blk.xName^), MKSTR(Sy.getName.ChPtr(tTy.idnt)^));
+  RESCUE (any)
+    (* Just leave tgXtn = NIL *)
+  END RescueOpaque;
+
 (* -------------------------------- *)
 
   PROCEDURE (os : PeFile)typ(tTy : Sy.Type) : Api.Type,NEW;
     VAR xtn : ANYPTR;
   BEGIN (* returns Api.Type descriptor for this type *)
     IF tTy.tgXtn = NIL THEN Mu.MkTypeName(tTy, os) END;
+    IF (tTy IS TypeDesc.Opaque) & (tTy.tgXtn = NIL) THEN os.RescueOpaque(tTy(TypeDesc.Opaque)) END;
     xtn := tTy.tgXtn;
+    IF xtn = NIL THEN 
+      IF tTy.xName # NIL THEN tTy.TypeErrStr(236, tTy.xName); 
+      ELSE tTy.TypeError(236); 
+      END;
+      RTS.Throw("Opaque Type Error");
+    END;
     WITH xtn : Api.Type DO
         RETURN xtn;
     | xtn : RecXtn DO

gpcp/Symbols.cp

@@ -1305,7 +1305,8 @@ MODULE Symbols;
                                 IN s : ARRAY OF CHAR),NEW,EXTENSIBLE;
     VAR l,c : INTEGER;
   BEGIN
-    IF ty.idnt # NIL THEN l := ty.idnt.token.lin; c := ty.idnt.token.col;
+    IF (ty.idnt # NIL) & (ty.idnt.token # NIL) THEN 
+      l := ty.idnt.token.lin; c := ty.idnt.token.col;
     ELSE l := S.line; c := S.col;
     END;
     S.SemError.RepSt1(n,s,l,c);