PR modula2/114807 badpointer3.mod causes an ICE

This patch fixes an ICE caused when a constant string
is built and attempted to be passed into a procedure with
an opaque type.

gcc/m2/ChangeLog:

	PR modula2/114807
	* gm2-compiler/M2Check.mod (checkUnbounded): Remove unused
	local variables.
	(constCheckMeta): Include check for IsReallyPointer in the
	failure case.
	* gm2-compiler/M2Quads.mod (MoveWithMode): Remove CopyConstString.
	* gm2-compiler/SymbolTable.def (IsHiddenReallyPointer): Export.
	* gm2-compiler/SymbolTable.mod (SkipHiddenType): Remove.
	(IsReallyPointer): Include IsHiddenReallyPointer test.

gcc/testsuite/ChangeLog:

	PR modula2/114807
	* gm2/pim/fail/badproctype.mod: Change MYSHORTREAL
	to SHORTREAL.
	* gm2/pim/fail/badprocbool.mod: New test.
	* gm2/pim/fail/badproccard.mod: New test.
	* gm2/pim/fail/badprocint.mod: New test.
	* gm2/pim/fail/badprocint2.mod: New test.
	* gm2/pim/pass/goodproccard2.mod: New test.
	* gm2/pim/pass/goodprocint.mod: New test.
	* gm2/pim/pass/goodprocint3.mod: New test.
	* gm2/pim/run/pass/genconststr.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

13 files changed, 143 insertions, 38 deletions

diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index a445193..1750fe0 100644
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -47,7 +47,8 @@ FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetSType, IsType,
                         IsReallyPointer, IsPointer, IsParameter, ModeOfAddr,
                         GetMode, GetType, IsUnbounded, IsComposite, IsConstructor,
                         IsParameter, IsConstString, IsConstLitInternal, IsConstLit,
-                        GetStringLength, GetProcedureProcType ;
+                        GetStringLength, GetProcedureProcType, IsHiddenType,
+                        IsHiddenReallyPointer ;
 
 FROM M2GCCDeclare IMPORT GetTypeMin, GetTypeMax ;
 FROM M2System IMPORT Address ;
@@ -264,9 +265,6 @@ END checkSubrange ;
 *)
 
 PROCEDURE checkUnbounded (result: status; tinfo: tInfo; unbounded, right: CARDINAL) : status ;
-VAR
-   lLow,  rLow,
-   lHigh, rHigh: CARDINAL ;
 BEGIN
    (* Firstly check to see if we have resolved this as false.  *)
    IF isFalse (result)
@@ -683,7 +681,8 @@ BEGIN
          THEN
             RETURN result
          ELSIF IsSet (typeRight) OR IsEnumeration (typeRight) OR
-               IsProcedure (typeRight) OR IsRecord (typeRight)
+               IsProcedure (typeRight) OR IsRecord (typeRight) OR
+               IsReallyPointer (typeRight)
          THEN
             RETURN false
          ELSIF IsArray (typeRight)
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 68b9120..8a9a230 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -73,7 +73,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
                         GetModuleQuads, GetProcedureQuads,
                         GetModuleCtors,
                         MakeProcedure,
-                        CopyConstString, PutConstStringKnown,
+                        PutConstStringKnown,
                         PutModuleStartQuad, PutModuleEndQuad,
                         PutModuleFinallyStartQuad, PutModuleFinallyEndQuad,
                         PutProcedureStartQuad, PutProcedureEndQuad,
@@ -3454,7 +3454,6 @@ BEGIN
    THEN
       GenQuadOtok (tokno, BecomesOp, Des, NulSym, Exp, TRUE,
                    destok, UnknownTokenNo, exptok) ;
-      CopyConstString (tokno, Des, Exp)
    ELSE
       IF GetMode(Des)=RightValue
       THEN
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index d7f0f8d..06f8a22 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -3037,6 +3037,14 @@ PROCEDURE IsHiddenTypeDeclared (Sym: CARDINAL) : BOOLEAN ;
 
 
 (*
+   IsHiddenReallyPointer - returns TRUE is sym is a pointer, address or a
+                           type declared as a pointer or address.
+*)
+
+PROCEDURE IsHiddenReallyPointer (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
    DisplayTrees - displays the SymbolTrees for Module symbol, ModSym.
 *)
 
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 7543bb5..f5890ec 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -8014,37 +8014,16 @@ END CheckForHiddenType ;
 
 PROCEDURE IsReallyPointer (Sym: CARDINAL) : BOOLEAN ;
 BEGIN
-   IF IsVar(Sym)
+   IF IsVar (Sym)
    THEN
-      Sym := GetType(Sym)
+      Sym := GetType (Sym)
    END ;
-   Sym := SkipType(Sym) ;
-   RETURN( IsPointer(Sym) OR (Sym=Address) )
+   Sym := SkipType (Sym) ;
+   RETURN IsPointer (Sym) OR (Sym = Address) OR IsHiddenReallyPointer (Sym)
 END IsReallyPointer ;
 
 
 (*
-   SkipHiddenType - if sym is a TYPE foo = bar
-                    then call SkipType(bar)
-                    else return sym
-
-                    it does skip over hidden type.
-*)
-
-(*
-PROCEDURE SkipHiddenType (Sym: CARDINAL) : CARDINAL ;
-BEGIN
-   IF (Sym#NulSym) AND IsType(Sym) AND (GetType(Sym)#NulSym)
-   THEN
-      RETURN( SkipType(GetType(Sym)) )
-   ELSE
-      RETURN( Sym )
-   END
-END SkipHiddenType ;
-*)
-
-
-(*
    IsHiddenReallyPointer - returns TRUE is sym is a pointer, address or a
                            type declared as a pointer or address.
 *)
diff --git a/gcc/testsuite/gm2/pim/fail/badprocbool.mod b/gcc/testsuite/gm2/pim/fail/badprocbool.mod
new file mode 100644
index 0000000..63bb034
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badprocbool.mod
@@ -0,0 +1,13 @@
+MODULE badprocbool ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE Func () : BOOLEAN ;
+BEGIN
+   RETURN TRUE
+END Func ;
+
+BEGIN
+   WriteString ('the value is: ') ; WriteCard (Func (), 5) ; WriteLn
+END badprocbool.
diff --git a/gcc/testsuite/gm2/pim/fail/badproccard.mod b/gcc/testsuite/gm2/pim/fail/badproccard.mod
new file mode 100644
index 0000000..3a6b8e5
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badproccard.mod
@@ -0,0 +1,13 @@
+MODULE badproccard ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE func () : CARDINAL ;
+BEGIN
+   RETURN 42
+END func ;
+
+BEGIN
+   WriteString ('the value is: ') ; WriteCard (func, 5) ; WriteLn
+END badproccard.
diff --git a/gcc/testsuite/gm2/pim/fail/badprocint.mod b/gcc/testsuite/gm2/pim/fail/badprocint.mod
new file mode 100644
index 0000000..c06241b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badprocint.mod
@@ -0,0 +1,17 @@
+MODULE badprocint ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE func () : INTEGER ;
+BEGIN
+   RETURN 42
+END func ;
+
+PROCEDURE PassRef (VAR x: CARDINAL) ;
+BEGIN
+END PassRef ;
+
+
+BEGIN
+   WriteString ('the value is: ') ; PassRef (func ()) ; WriteLn
+END badprocint.
diff --git a/gcc/testsuite/gm2/pim/fail/badprocint2.mod b/gcc/testsuite/gm2/pim/fail/badprocint2.mod
new file mode 100644
index 0000000..4d2901e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badprocint2.mod
@@ -0,0 +1,14 @@
+MODULE badprocint2 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE PassRef (VAR x: CARDINAL) ;
+BEGIN
+END PassRef ;
+
+VAR
+   i: INTEGER ;
+BEGIN
+   i := 42 ;
+   WriteString ('the value is: ') ; PassRef (i) ; WriteLn
+END badprocint2.
diff --git a/gcc/testsuite/gm2/pim/fail/badproctype.mod b/gcc/testsuite/gm2/pim/fail/badproctype.mod
index 1921a8e..cff3a31 100644
--- a/gcc/testsuite/gm2/pim/fail/badproctype.mod
+++ b/gcc/testsuite/gm2/pim/fail/badproctype.mod
@@ -1,22 +1,19 @@
 MODULE badproctype ;
 
 TYPE
-   MYSHORTREAL = REAL;
-
-TYPE
    PROCA = PROCEDURE (VAR ARRAY OF REAL);
-   PROCB = PROCEDURE (VAR ARRAY OF MYSHORTREAL);
+   PROCB = PROCEDURE (VAR ARRAY OF SHORTREAL);
 
 VAR
    pa: PROCA; pb: PROCB;
    x: ARRAY [0..1] OF REAL;
-   y: ARRAY [0..1] OF MYSHORTREAL;
+   y: ARRAY [0..1] OF SHORTREAL;
 
 PROCEDURE ProcA(VAR z: ARRAY OF REAL);
 BEGIN
 END ProcA ;
 
-PROCEDURE ProcB(VAR z: ARRAY OF MYSHORTREAL);
+PROCEDURE ProcB(VAR z: ARRAY OF SHORTREAL);
 BEGIN
 END ProcB ;
 
diff --git a/gcc/testsuite/gm2/pim/pass/goodproccard2.mod b/gcc/testsuite/gm2/pim/pass/goodproccard2.mod
new file mode 100644
index 0000000..f2f5c6e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/goodproccard2.mod
@@ -0,0 +1,16 @@
+MODULE badproccard2 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE func () : INTEGER ;
+BEGIN
+   RETURN 42
+END func ;
+
+PROCEDURE PassValue (x: CARDINAL) ;
+BEGIN
+END PassValue ;
+
+BEGIN
+   WriteString ('the value is: ') ; PassValue (func ()) ; WriteLn
+END badproccard2.
diff --git a/gcc/testsuite/gm2/pim/pass/goodprocint.mod b/gcc/testsuite/gm2/pim/pass/goodprocint.mod
new file mode 100644
index 0000000..2ace578
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/goodprocint.mod
@@ -0,0 +1,13 @@
+MODULE goodprocint ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE func () : INTEGER ;
+BEGIN
+   RETURN 42
+END func ;
+
+BEGIN
+   WriteString ('the value is: ') ; WriteCard (func (), 5) ; WriteLn
+END goodprocint.
diff --git a/gcc/testsuite/gm2/pim/pass/goodprocint3.mod b/gcc/testsuite/gm2/pim/pass/goodprocint3.mod
new file mode 100644
index 0000000..fcc1e73
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/goodprocint3.mod
@@ -0,0 +1,14 @@
+MODULE goodprocint3 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE PassValue (x: CARDINAL) ;
+BEGIN
+END PassValue ;
+
+VAR
+   i: INTEGER ;
+BEGIN
+   i := 42 ;
+   WriteString ('the value is: ') ; PassValue (i) ; WriteLn
+END goodprocint3.
diff --git a/gcc/testsuite/gm2/pim/run/pass/genconststr.mod b/gcc/testsuite/gm2/pim/run/pass/genconststr.mod
new file mode 100644
index 0000000..d8fa842
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/genconststr.mod
@@ -0,0 +1,23 @@
+MODULE genconststr ;
+
+FROM libc IMPORT printf, exit ;
+FROM StrLib IMPORT StrEqual ;
+
+CONST
+   foo = hello + space + world ;
+   hello = "hello" ;
+   space = " " ;
+   world = "world" ;
+
+PROCEDURE test (a: ARRAY OF CHAR) ;
+BEGIN
+   IF NOT StrEqual (a, "hello world")
+   THEN
+      printf ("const string failed\n");
+      exit (1)
+   END
+END test ;
+
+BEGIN
+   test (foo)
+END genconststr.