From b69945d511b394ef092c888c6475f8c72bee0c03 Mon Sep 17 00:00:00 2001 From: Gaius Mulley Date: Fri, 28 Mar 2025 15:25:55 +0000 Subject: [PATCH] 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 --- gcc/m2/gm2-compiler/M2Quads.mod | 51 +++++++++++++++---- gcc/testsuite/gm2/iso/fail/conststrarray2.mod | 30 +++++++++++ .../gm2/iso/run/pass/constarray2.mod | 33 ++++++++++++ gcc/testsuite/gm2/pim/pass/hexstring.mod | 16 ++++++ 4 files changed, 120 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gm2/iso/fail/conststrarray2.mod create mode 100644 gcc/testsuite/gm2/iso/run/pass/constarray2.mod create mode 100644 gcc/testsuite/gm2/pim/pass/hexstring.mod diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 573fd74e4f1..9bb8c4d35a6 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 00000000000..ab101d4a95b --- /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 00000000000..19beb6f7962 --- /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 00000000000..92992825926 --- /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.