https://gcc.gnu.org/g:b69945d511b394ef092c888c6475f8c72bee0c03
commit r15-9011-gb69945d511b394ef092c888c6475f8c72bee0c03
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Fri Mar 28 15:25:55 2025 +0000
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 <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Quads.mod | 51 +++++++++++++++++++++-----
gcc/testsuite/gm2/iso/fail/conststrarray2.mod | 30 +++++++++++++++
gcc/testsuite/gm2/iso/run/pass/constarray2.mod | 33 +++++++++++++++++
gcc/testsuite/gm2/pim/pass/hexstring.mod | 16 ++++++++
4 files changed, 120 insertions(+), 10 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 573fd74e4f15..9bb8c4d35a64 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 000000000000..ab101d4a95bf
--- /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 000000000000..19beb6f7962d
--- /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 000000000000..92992825926d
--- /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.
