public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r14-9136] PR modula2/114055 improve error message when checking the BY constant
@ 2024-02-22 15:06 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2024-02-22 15:06 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:c1667b1ef538e4da10cf83bdf1ae62d7bdd96128
commit r14-9136-gc1667b1ef538e4da10cf83bdf1ae62d7bdd96128
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Thu Feb 22 15:02:19 2024 +0000
PR modula2/114055 improve error message when checking the BY constant
The fix marks a constant created during the default BY clause of the
FOR loop as internal. The type checker will always return true if
checking against an internal const.
gcc/m2/ChangeLog:
PR modula2/114055
* gm2-compiler/M2Check.mod (Import): IsConstLitInternal and
IsConstLit.
(isInternal): New procedure function.
(doCheck): Test for isInternal in either operand and early
return true.
* gm2-compiler/M2Quads.mod (PushOne): Rewrite with extra
parameter internal.
(BuildPseudoBy): Add TRUE parameter to PushOne call.
(BuildIncProcedure): Add FALSE parameter to PushOne call.
(BuildDecProcedure): Add FALSE parameter to PushOne call.
* gm2-compiler/M2Range.mod (ForLoopBeginTypeCompatible):
Uncomment code and tidy up error string.
* gm2-compiler/SymbolTable.def (PutConstLitInternal):
New procedure.
(IsConstLitInternal): New procedure function.
* gm2-compiler/SymbolTable.mod (PutConstLitInternal):
New procedure.
(IsConstLitInternal): New procedure function.
(SymConstLit): New field IsInternal.
(CreateConstLit): Initialize IsInternal to FALSE.
gcc/testsuite/ChangeLog:
PR modula2/114055
* gm2/pim/fail/forloopby.mod: New test.
* gm2/pim/pass/forloopby2.mod: New test.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Check.mod | 28 ++++++++++++++++-
gcc/m2/gm2-compiler/M2Quads.mod | 29 ++++++++++++-----
gcc/m2/gm2-compiler/M2Range.mod | 4 +--
gcc/m2/gm2-compiler/SymbolTable.def | 19 +++++++++++
gcc/m2/gm2-compiler/SymbolTable.mod | 52 ++++++++++++++++++++++++++++++-
gcc/testsuite/gm2/pim/fail/forloopby.mod | 17 ++++++++++
gcc/testsuite/gm2/pim/pass/forloopby2.mod | 18 +++++++++++
7 files changed, 154 insertions(+), 13 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index a296766ba35c..5b45ad39c118 100644
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -39,7 +39,15 @@ FROM M2Error IMPORT Error, InternalError, NewError, ErrorString, ChainError ;
FROM M2MetaError IMPORT MetaErrorStringT2, MetaErrorStringT3, MetaErrorStringT4, MetaString2, MetaString3, MetaString4 ;
FROM StrLib IMPORT StrEqual ;
FROM M2Debug IMPORT Assert ;
-FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetSType, IsType, SkipType, IsProcedure, NoOfParam, IsVarParam, GetNth, GetNthParam, IsProcType, IsVar, IsEnumeration, IsArray, GetDeclaredMod, IsSubrange, GetArraySubscript, IsConst, IsReallyPointer, IsPointer, IsParameter, ModeOfAddr, GetMode, GetType, IsUnbounded, IsComposite, IsConstructor, IsParameter, IsConstString ;
+
+FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetSType, IsType,
+ SkipType, IsProcedure, NoOfParam, IsVarParam, GetNth,
+ GetNthParam, IsProcType, IsVar, IsEnumeration, IsArray,
+ GetDeclaredMod, IsSubrange, GetArraySubscript, IsConst,
+ IsReallyPointer, IsPointer, IsParameter, ModeOfAddr,
+ GetMode, GetType, IsUnbounded, IsComposite, IsConstructor,
+ IsParameter, IsConstString, IsConstLitInternal, IsConstLit ;
+
FROM M2GCCDeclare IMPORT GetTypeMin, GetTypeMax ;
FROM M2System IMPORT Address ;
FROM M2ALU IMPORT Equ, PushIntegerTree ;
@@ -1370,6 +1378,17 @@ BEGIN
END get ;
+(*
+ isInternal - return TRUE if sym is a constant lit which was declared
+ as internal.
+*)
+
+PROCEDURE isInternal (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN IsConstLit (sym) AND IsConstLitInternal (sym)
+END isInternal ;
+
+
(*
doCheck - keep obtaining an unresolved pair and check for the
type compatibility. This is the main check routine used by
@@ -1393,6 +1412,13 @@ BEGIN
printf ("doCheck (%d, %d)\n", left, right) ;
dumptInfo (tinfo)
END ;
+ IF isInternal (left) OR isInternal (right)
+ THEN
+ (* Do not check constants which have been generated internally.
+ Currently these are generated by the default BY constant value
+ in a FOR loop. *)
+ RETURN TRUE
+ END ;
(*
IF in (tinfo^.visited, left, right)
THEN
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 1275ad2fe1cf..ff0fda9cd412 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -85,6 +85,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
PutPriority, GetPriority,
PutProcedureBegin, PutProcedureEnd,
PutVarConst, IsVarConst,
+ PutConstLitInternal,
PutVarHeap,
IsVarParam, IsProcedure, IsPointer, IsParameter,
IsUnboundedParam, IsEnumeration, IsDefinitionForC,
@@ -4347,11 +4348,16 @@ END BuildElsif2 ;
|------------|
*)
-PROCEDURE PushOne (tok: CARDINAL; type: CARDINAL; message: ARRAY OF CHAR) ;
+PROCEDURE PushOne (tok: CARDINAL; type: CARDINAL;
+ message: ARRAY OF CHAR; internal: BOOLEAN) ;
+VAR
+ const: CARDINAL ;
BEGIN
IF type = NulSym
THEN
- PushTF (MakeConstLit (tok, MakeKey('1'), NulSym), NulSym)
+ const := MakeConstLit (tok, MakeKey('1'), NulSym) ;
+ PutConstLitInternal (const, TRUE) ;
+ PushTFtok (const, NulSym, tok)
ELSIF IsEnumeration (type)
THEN
IF NoOfElements (type) = 0
@@ -4361,14 +4367,16 @@ BEGIN
type) ;
PushZero (tok, type)
ELSE
- PushTF (Convert, NulSym) ;
+ PushTFtok (Convert, NulSym, tok) ;
PushT (type) ;
- PushT (MakeConstLit (tok, MakeKey ('1'), ZType)) ;
+ PushTFtok (MakeConstLit (tok, MakeKey ('1'), ZType), ZType, tok) ;
PushT (2) ; (* Two parameters *)
BuildConvertFunction
END
ELSE
- PushTF (MakeConstLit (tok, MakeKey ('1'), type), type)
+ const := MakeConstLit (tok, MakeKey ('1'), type) ;
+ PutConstLitInternal (const, TRUE) ;
+ PushTFtok (const, type, tok)
END
END PushOne ;
@@ -4440,7 +4448,8 @@ BEGIN
THEN
type := ZType
END ;
- PushOne (dotok, type, 'the implied {%kFOR} loop increment will cause an overflow {%1ad}')
+ PushOne (dotok, type,
+ 'the implied {%kFOR} loop increment will cause an overflow {%1ad}', TRUE)
END BuildPseudoBy ;
@@ -4648,6 +4657,8 @@ END BuildForToByDo ;
Ptr ->
+----------------+
+ | RangeId |
+ |----------------|
| ForQuad |
|----------------|
| LastValue |
@@ -7294,7 +7305,8 @@ BEGIN
THEN
OperandSym := DereferenceLValue (OperandTok (1), OperandT (1))
ELSE
- PushOne (proctok, dtype, 'the {%EkINC} will cause an overflow {%1ad}') ;
+ PushOne (proctok, dtype,
+ 'the {%EkINC} will cause an overflow {%1ad}', FALSE) ;
PopT (OperandSym)
END ;
@@ -7366,7 +7378,8 @@ BEGIN
THEN
OperandSym := DereferenceLValue (OperandTok (1), OperandT (1))
ELSE
- PushOne (proctok, dtype, 'the {%EkDEC} will cause an overflow {%1ad}') ;
+ PushOne (proctok, dtype,
+ 'the {%EkDEC} will cause an overflow {%1ad}', FALSE) ;
PopT (OperandSym)
END ;
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
index fa1ef35c4c4e..654ac046c6fb 100644
--- a/gcc/m2/gm2-compiler/M2Range.mod
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -1886,16 +1886,14 @@ BEGIN
des, expr2) ;
success := FALSE
END ;
-(*
combinedtok := MakeVirtual2Tok (destok, byconsttok) ;
IF NOT ExpressionTypeCompatible (combinedtok, "", des, byconst, TRUE, FALSE)
THEN
MetaErrorT2 (combinedtok,
- 'type expression incompatibility between {%1Et} and {%2t} detected between the the designator {%1a} and the {%kBY} constant expression {%2a} in the {%kFOR} loop',
+ 'type expression incompatibility between {%1Et} and {%2t} detected between the designator {%1a} and the {%kBY} constant expression {%2a} in the {%kFOR} loop',
des, byconst) ;
success := FALSE
END ;
-*)
IF (NOT success) AND (incrementquad # 0)
THEN
(* Avoid a subsequent generic type check error. *)
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index 508b818767ee..ec48631e43fe 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -3315,4 +3315,23 @@ PROCEDURE PutProcedureParameterHeapVars (sym: CARDINAL) ;
PROCEDURE IsProcedureBuiltinAvailable (procedure: CARDINAL) : BOOLEAN ;
+(*
+ PutConstLitInternal - marks the sym as being an internal constant.
+ Currently this is used when generating a default
+ BY constant expression during a FOR loop.
+ A constant marked as internal will always pass
+ an expression type check.
+*)
+
+PROCEDURE PutConstLitInternal (sym: CARDINAL; value: BOOLEAN) ;
+
+
+(*
+ IsConstLitInternal - returns the value of the IsInternal field within
+ a constant expression.
+*)
+
+PROCEDURE IsConstLitInternal (sym: CARDINAL) : BOOLEAN ;
+
+
END SymbolTable.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 6fe36da0bbca..c57c0333188c 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -487,7 +487,8 @@ TYPE
Value : PtrToValue ; (* Value of the constant. *)
Type : CARDINAL ; (* TYPE of constant, char etc *)
IsSet : BOOLEAN ; (* is the constant a set? *)
- IsConstructor: BOOLEAN ; (* is the constant a set? *)
+ IsConstructor: BOOLEAN ; (* is it a constructor? *)
+ IsInternal : BOOLEAN ; (* Generated internally? *)
FromType : CARDINAL ; (* type is determined FromType *)
RangeError : BOOLEAN ; (* Have we reported an error? *)
UnresFromType: BOOLEAN ; (* is Type unresolved? *)
@@ -4865,6 +4866,8 @@ BEGIN
PopInto (ConstLit.Value) ;
ConstLit.Type := constType ;
ConstLit.IsSet := FALSE ;
+ ConstLit.IsInternal := FALSE ; (* Is it a default BY constant
+ expression? *)
ConstLit.IsConstructor := FALSE ;
ConstLit.FromType := NulSym ; (* type is determined FromType *)
ConstLit.RangeError := overflow ;
@@ -6790,6 +6793,53 @@ BEGIN
END PutConst ;
+(*
+ PutConstLitInternal - marks the sym as being an internal constant.
+ Currently this is used when generating a default
+ BY constant expression during a FOR loop.
+ A constant marked as internal will always pass
+ an expression type check.
+*)
+
+PROCEDURE PutConstLitInternal (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ConstLitSym: ConstLit.IsInternal := value
+
+ ELSE
+ InternalError ('expecting ConstLitSym')
+ END
+ END
+END PutConstLitInternal ;
+
+
+(*
+ IsConstLitInternal - returns the value of the IsInternal field within
+ a constant expression.
+*)
+
+PROCEDURE IsConstLitInternal (sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ConstLitSym: RETURN ConstLit.IsInternal
+
+ ELSE
+ InternalError ('expecting ConstLitSym')
+ END
+ END
+END IsConstLitInternal ;
+
+
(*
PutVarArrayRef - assigns ArrayRef field with value.
*)
diff --git a/gcc/testsuite/gm2/pim/fail/forloopby.mod b/gcc/testsuite/gm2/pim/fail/forloopby.mod
new file mode 100644
index 000000000000..522563bb69be
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/forloopby.mod
@@ -0,0 +1,17 @@
+MODULE forloopby ;
+
+
+PROCEDURE init ;
+CONST
+ increment = CARDINAL (1) ;
+VAR
+ i: INTEGER ;
+BEGIN
+ FOR i := 0 TO 10 BY increment DO
+ END
+END init ;
+
+
+BEGIN
+ init
+END forloopby.
diff --git a/gcc/testsuite/gm2/pim/pass/forloopby2.mod b/gcc/testsuite/gm2/pim/pass/forloopby2.mod
new file mode 100644
index 000000000000..a81ecb08da3f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/pass/forloopby2.mod
@@ -0,0 +1,18 @@
+MODULE forloopby2 ;
+
+TYPE
+ negative = [-10..-1] ;
+
+
+PROCEDURE init ;
+VAR
+ i: negative ;
+BEGIN
+ FOR i := MIN (negative) TO MAX (negative) DO
+ END
+END init ;
+
+
+BEGIN
+ init
+END forloopby2.
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2024-02-22 15:06 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-02-22 15:06 [gcc r14-9136] PR modula2/114055 improve error message when checking the BY constant Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).