PR modula2/118453: Subranges types do not use virtual tokens during construction

P2SymBuild.mod.BuildSubrange does not use a virtual token and therefore
any error message containing a subrange type produces poor location carots.
This patch rewrites BuildSubrange and the buildError4 procedure in
M2Check.mod (which is only called when there is a formal/actual parameter
mismatch).  buildError4 now issues a sub error for the formal and actual
type declaration highlighing the type mismatch.

gcc/m2/ChangeLog:

	PR modula2/118453
	* gm2-compiler/M2Check.mod (buildError4): Call MetaError1
	for the actual and formal parameter type.
	* gm2-compiler/P2Build.bnf (SubrangeType): Construct a virtual
	token containing the subrange type declaration.
	(PrefixedSubrangeType): Ditto.
	* gm2-compiler/P2SymBuild.def (BuildSubrange): Add tok parameter.
	* gm2-compiler/P2SymBuild.mod (BuildSubrange): Use tok parameter,
	rather than the token at the start of the subrange.

gcc/testsuite/ChangeLog:

	PR modula2/118453
	* gm2/pim/fail/badbecomes2.mod: New test.
	* gm2/pim/fail/badparamset1.mod: New test.
	* gm2/pim/fail/badparamset2.mod: New test.
	* gm2/pim/fail/badsyntaxset1.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
This commit is contained in:
Gaius Mulley 2025-01-13 14:40:43 +00:00
parent d23d338da4
commit 7cd4de65ff
8 changed files with 68 additions and 15 deletions

View file

@ -36,7 +36,7 @@ FROM M2System IMPORT IsSystemType, IsGenericSystemType, IsSameSize, IsComplexN ;
FROM M2Base IMPORT IsParameterCompatible, IsAssignmentCompatible, IsExpressionCompatible, IsComparisonCompatible, IsBaseType, IsMathType, ZType, CType, RType, IsComplexType, Char ;
FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, KillIndex, HighIndice, LowIndice, IncludeIndiceIntoIndex, ForeachIndiceInIndexDo ;
FROM M2Error IMPORT Error, InternalError, NewError, ErrorString, ChainError ;
FROM M2MetaError IMPORT MetaErrorStringT2, MetaErrorStringT3, MetaErrorStringT4, MetaString2, MetaString3, MetaString4 ;
FROM M2MetaError IMPORT MetaErrorStringT2, MetaErrorStringT3, MetaErrorStringT4, MetaString2, MetaString3, MetaString4, MetaError1 ;
FROM StrLib IMPORT StrEqual ;
FROM M2Debug IMPORT Assert ;
@ -504,10 +504,8 @@ BEGIN
(* and also generate a sub error containing detail. *)
IF (left # tinfo^.left) OR (right # tinfo^.right)
THEN
tinfo^.error := ChainError (tinfo^.token, tinfo^.error) ;
s := MetaString2 (InitString ("{%1Ead} and {%2ad} are incompatible as formal and actual procedure parameters"),
left, right) ;
ErrorString (tinfo^.error, s)
MetaError1 ('formal parameter {%1EDad}', right) ;
MetaError1 ('actual parameter {%1EDad}', left)
END
END
END buildError4 ;

View file

@ -45,7 +45,9 @@ see <https://www.gnu.org/licenses/>. *)
IMPLEMENTATION MODULE P2Build ;
FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken, InsertTokenAndRewind, GetTokenNo ;
FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
InsertTokenAndRewind, GetTokenNo, MakeVirtual2Tok ;
FROM M2MetaError IMPORT MetaErrorStringT0, MetaErrorT1 ;
FROM NameKey IMPORT NulName, Name, makekey, MakeKey ;
FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok, QualifiedTok, UnQualifiedTok ;
@ -765,12 +767,17 @@ IdentList := Ident % VAR
END %
=:
SubrangeType := "[" ConstExpression ".." ConstExpression "]" % BuildSubrange(NulSym) %
SubrangeType := % VAR start, combined: CARDINAL ; %
% start := GetTokenNo () %
"[" ConstExpression ".." ConstExpression "]" % combined := MakeVirtual2Tok (start, GetTokenNo ()-1) %
% BuildSubrange (combined, NulSym) %
=:
PrefixedSubrangeType := "[" ConstExpression ".." ConstExpression "]" % VAR t: CARDINAL ; %
% PopT(t) ;
BuildSubrange(t) %
PrefixedSubrangeType := % VAR qual, start, combined: CARDINAL ; %
% PopTtok (qual, start) %
"[" ConstExpression ".." ConstExpression "]"
% combined := MakeVirtual2Tok (start, GetTokenNo ()-1) %
% BuildSubrange (combined, qual) %
=:
ArrayType := "ARRAY" % VAR arrayType, tok: CARDINAL ; %

View file

@ -432,7 +432,7 @@ PROCEDURE StartBuildEnumeration ;
|------------| |------------|
*)
PROCEDURE BuildSubrange (Base: CARDINAL) ;
PROCEDURE BuildSubrange (tok: CARDINAL; Base: CARDINAL) ;
(*

View file

@ -907,14 +907,13 @@ END StartBuildEnumeration ;
|------------| |------------|
*)
PROCEDURE BuildSubrange (Base: CARDINAL) ;
PROCEDURE BuildSubrange (tok: CARDINAL; Base: CARDINAL) ;
VAR
name: Name ;
Type: CARDINAL ;
tok : CARDINAL ;
BEGIN
PopTtok(name, tok) ;
Type := MakeSubrange(tok, name) ;
PopT (name) ;
Type := MakeSubrange (tok, name) ;
PutSubrangeIntoFifoQueue(Type) ; (* Store Subrange away so that we can fill in *)
(* its bounds during pass 3. *)
PutSubrangeIntoFifoQueue(Base) ; (* store Base type of subrange away as well. *)

View file

@ -0,0 +1,9 @@
MODULE badbecomes2 ;
TYPE
enums = (red, blue, green) ;
VAR
setvar: SET OF enums ;
BEGIN
setvar := green ; (* Should detect an error here. *)
END badbecomes2.

View file

@ -0,0 +1,16 @@
MODULE badparamset1 ;
TYPE
month = SET OF [1..12] ;
day = SET OF [1..31] ;
PROCEDURE foo (d: day) ;
BEGIN
END foo ;
VAR
m: month ;
BEGIN
foo (m)
END badparamset1.

View file

@ -0,0 +1,16 @@
MODULE badparamset2 ;
TYPE
month = SET OF [1..12] ;
day = SET OF [1..31] ;
PROCEDURE foo (d: day) ;
BEGIN
END foo ;
VAR
m: month ;
BEGIN
foo (m)
END badparamset2.

View file

@ -0,0 +1,8 @@
MODULE badsyntaxset1 ;
TYPE
foo = SET OF [cat..dog] ;
BEGIN
END badsyntaxset1.