https://gcc.gnu.org/g:7cd4de65ffb3f34d6ba5af2f9570900fecd7bed0
commit r15-6868-g7cd4de65ffb3f34d6ba5af2f9570900fecd7bed0
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Mon Jan 13 14:40:43 2025 +0000
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 <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Check.mod | 8 +++-----
gcc/m2/gm2-compiler/P2Build.bnf | 17 ++++++++++++-----
gcc/m2/gm2-compiler/P2SymBuild.def | 2 +-
gcc/m2/gm2-compiler/P2SymBuild.mod | 7 +++----
gcc/testsuite/gm2/pim/fail/badbecomes2.mod | 9 +++++++++
gcc/testsuite/gm2/pim/fail/badparamset1.mod | 16 ++++++++++++++++
gcc/testsuite/gm2/pim/fail/badparamset2.mod | 16 ++++++++++++++++
gcc/testsuite/gm2/pim/fail/badsyntaxset1.mod | 8 ++++++++
8 files changed, 68 insertions(+), 15 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index 9e58ef05d36c..d2bb4ab7da35 100644
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -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 ;
diff --git a/gcc/m2/gm2-compiler/P2Build.bnf b/gcc/m2/gm2-compiler/P2Build.bnf
index f1eafc83da7c..b9a6daa70b2e 100644
--- a/gcc/m2/gm2-compiler/P2Build.bnf
+++ b/gcc/m2/gm2-compiler/P2Build.bnf
@@ -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 ; %
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.def
b/gcc/m2/gm2-compiler/P2SymBuild.def
index b570286d03b3..eab8c42d9218 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.def
+++ b/gcc/m2/gm2-compiler/P2SymBuild.def
@@ -432,7 +432,7 @@ PROCEDURE StartBuildEnumeration ;
|------------| |------------|
*)
-PROCEDURE BuildSubrange (Base: CARDINAL) ;
+PROCEDURE BuildSubrange (tok: CARDINAL; Base: CARDINAL) ;
(*
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod
b/gcc/m2/gm2-compiler/P2SymBuild.mod
index a625e7dd95d7..1b59f3d631b6 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -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. *)
diff --git a/gcc/testsuite/gm2/pim/fail/badbecomes2.mod
b/gcc/testsuite/gm2/pim/fail/badbecomes2.mod
new file mode 100644
index 000000000000..323043981d51
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badbecomes2.mod
@@ -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.
diff --git a/gcc/testsuite/gm2/pim/fail/badparamset1.mod
b/gcc/testsuite/gm2/pim/fail/badparamset1.mod
new file mode 100644
index 000000000000..35d4f488f466
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badparamset1.mod
@@ -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.
diff --git a/gcc/testsuite/gm2/pim/fail/badparamset2.mod
b/gcc/testsuite/gm2/pim/fail/badparamset2.mod
new file mode 100644
index 000000000000..bddc745f244b
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badparamset2.mod
@@ -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.
diff --git a/gcc/testsuite/gm2/pim/fail/badsyntaxset1.mod
b/gcc/testsuite/gm2/pim/fail/badsyntaxset1.mod
new file mode 100644
index 000000000000..0bf498ce6f0d
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badsyntaxset1.mod
@@ -0,0 +1,8 @@
+MODULE badsyntaxset1 ;
+
+TYPE
+ foo = SET OF [cat..dog] ;
+
+BEGIN
+
+END badsyntaxset1.
