procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

PR modula2/114055 improve error message when checking the BY constant

Browse source 
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>
This commit is contained in:
Gaius Mulley 2024-02-22 15:02:19 +00:00
parent 92c4029799
commit c1667b1ef5
7 changed files with 154 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
gcc/m2/gm2-compiler/M2Check.mod
View file

@ -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

29
gcc/m2/gm2-compiler/M2Quads.mod
View file

@ -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 ;

4
gcc/m2/gm2-compiler/M2Range.mod
View file

@ -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. *)

19
gcc/m2/gm2-compiler/SymbolTable.def
View file

@ -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.

52
gcc/m2/gm2-compiler/SymbolTable.mod
View file

@ -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.
*)

17
gcc/testsuite/gm2/pim/fail/forloopby.mod Normal file
View file

@ -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.

18
gcc/testsuite/gm2/pim/pass/forloopby2.mod Normal file
View file

@ -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.