PR modula2/119504: ICE when attempting to access an element of a constant string

This patch prevents an ICE and generates an error if an array access to a
constant string is attempted.  The patch also allows HIGH ("string").

gcc/m2/ChangeLog:

	PR modula2/119504
	* gm2-compiler/M2Quads.mod (BuildHighFunction): Defend against
	Type = NulSym and fall into BuildConstHighFromSym.
	(BuildDesignatorArray): Rewrite to detect an array access to
	a constant string.
	(BuildDesignatorArrayStaticDynamic): New procedure.

gcc/testsuite/ChangeLog:

	PR modula2/119504
	* gm2/iso/fail/conststrarray2.mod: New test.
	* gm2/iso/run/pass/constarray2.mod: New test.
	* gm2/pim/pass/hexstring.mod: New test.

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

4 files changed, 120 insertions, 10 deletions

diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 573fd74..9bb8c4d 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -8474,7 +8474,7 @@ BEGIN
       THEN
          (* we cannot test for IsConst(Param) AND (GetSType(Param)=Char)  as the type might not be assigned yet *)
          MetaError1 ('base procedure {%EkHIGH} expects a variable or string constant as its parameter {%1d:rather than {%1d}} {%1asa}', Param)
-      ELSIF IsUnbounded(Type)
+      ELSIF (Type # NulSym) AND IsUnbounded(Type)
       THEN
          BuildHighFromUnbounded (combinedtok)
       ELSE
@@ -11481,13 +11481,12 @@ END BuildDesignatorPointerError ;
 (*
    BuildDesignatorArray - Builds the array referencing.
                           The purpose of this procedure is to work out
-                          whether the DesignatorArray is a static or
-                          dynamic array and to call the appropriate
+                          whether the DesignatorArray is a constant string or
+                          dynamic array/static array and to call the appropriate
                           BuildRoutine.
 
                           The Stack is expected to contain:
 
-
                           Entry                   Exit
                           =====                   ====
 
@@ -11500,6 +11499,41 @@ END BuildDesignatorPointerError ;
 *)
 
 PROCEDURE BuildDesignatorArray ;
+BEGIN
+   IF IsConst (OperandT (2)) AND IsConstString (OperandT (2))
+   THEN
+      MetaErrorT1 (OperandTtok (2),
+                   '{%1Ead} is not an array, but a constant string.  Hint use a string constant created with an array constructor',
+                   OperandT (2)) ;
+      BuildDesignatorError ('bad array access')
+   ELSE
+      BuildDesignatorArrayStaticDynamic
+   END
+END BuildDesignatorArray ;
+
+
+(*
+   BuildDesignatorArrayStaticDynamic - Builds the array referencing.
+                                       The purpose of this procedure is to work out
+                                       whether the DesignatorArray is a static or
+                                       dynamic array and to call the appropriate
+                                       BuildRoutine.
+
+                                       The Stack is expected to contain:
+
+
+                                       Entry                   Exit
+                                       =====                   ====
+
+                                Ptr ->
+                                       +--------------+
+                                       | e            |                        <- Ptr
+                                       |--------------|        +------------+
+                                       | Sym  | Type  |        | S    | T   |
+                                       |--------------|        |------------|
+*)
+
+PROCEDURE BuildDesignatorArrayStaticDynamic ;
 VAR
    combinedTok,
    arrayTok,
@@ -11512,10 +11546,7 @@ BEGIN
    IF IsConst (OperandT (2))
    THEN
       type := GetDType (OperandT (2)) ;
-      IF type = NulSym
-      THEN
-         InternalError ('constant type should have been resolved')
-      ELSIF IsArray (type)
+      IF (type # NulSym) AND IsArray (type)
       THEN
          PopTtok (e, exprTok) ;
          PopTFDtok (Sym, Type, dim, arrayTok) ;
@@ -11533,7 +11564,7 @@ BEGIN
    IF (NOT IsVar (OperandT (2))) AND (NOT IsTemporary (OperandT (2)))
    THEN
       MetaErrorT1 (OperandTtok (2),
-                   'can only access arrays using variables or formal parameters not {%1Ead}',
+                   'can only access arrays using constants, variables or formal parameters not {%1Ead}',
                    OperandT (2)) ;
       BuildDesignatorError ('bad array access')
    END ;
@@ -11560,7 +11591,7 @@ BEGIN
                    Sym) ;
       BuildDesignatorError ('bad array access')
    END
-END BuildDesignatorArray ;
+END BuildDesignatorArrayStaticDynamic ;
 
 
 (*
diff --git a/gcc/testsuite/gm2/iso/fail/conststrarray2.mod b/gcc/testsuite/gm2/iso/fail/conststrarray2.mod
new file mode 100644
index 0000000..ab101d4
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/conststrarray2.mod
@@ -0,0 +1,30 @@
+MODULE conststrarray2 ;
+
+FROM libc IMPORT printf, exit ;
+
+CONST
+   HelloWorld = Hello + " " + World ;
+   Hello = "Hello" ;
+   World = "World" ;
+
+
+(*
+   Assert - 
+*)
+
+PROCEDURE Assert (result: BOOLEAN) ;
+BEGIN
+   IF NOT result
+   THEN
+      printf ("assertion failed\n") ;
+      exit (1)
+   END
+END Assert ;
+
+
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := HelloWorld[4] ;
+   Assert (ch = 'o')
+END conststrarray2.
diff --git a/gcc/testsuite/gm2/iso/run/pass/constarray2.mod b/gcc/testsuite/gm2/iso/run/pass/constarray2.mod
new file mode 100644
index 0000000..19beb6f
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/run/pass/constarray2.mod
@@ -0,0 +1,33 @@
+MODULE constarray2 ;
+
+FROM libc IMPORT printf, exit ;
+
+TYPE
+   arraytype = ARRAY [0..11] OF CHAR ;
+   
+CONST
+   Hello = "Hello" ;
+   World = "World" ;
+   HelloWorld = arraytype {Hello + " " + World} ;
+
+
+(*
+   Assert - 
+*)
+
+PROCEDURE Assert (result: BOOLEAN) ;
+BEGIN
+   IF NOT result
+   THEN
+      printf ("assertion failed\n") ;
+      exit (1)
+   END
+END Assert ;
+
+
+VAR
+   ch: CHAR ;
+BEGIN
+   ch := HelloWorld[4] ;
+   Assert (ch = 'o')
+END constarray2.
diff --git a/gcc/testsuite/gm2/pim/pass/hexstring.mod b/gcc/testsuite/gm2/pim/pass/hexstring.mod
new file mode 100644
index 0000000..9299282
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/hexstring.mod
@@ -0,0 +1,16 @@
+MODULE hexstring ;  
+
+CONST
+   HexDigits = "0123456789ABCDEF" ;
+
+TYPE
+   ArrayType = ARRAY [0..HIGH (HexDigits)] OF CHAR ;
+
+CONST
+   HexArray = ArrayType { HexDigits } ;
+
+VAR
+   four: CHAR ;
+BEGIN
+   four := HexArray[4]
+END hexstring.