This followup patch ensures that any unknown symbol spell check
error in the instrinsics uses the parameter token rather than the
procedure name token. In turn this allows the filter module to
detect and remove multiple unknowns at the same token.
The patch also adds spell checking to the instrinsic parameters.
gcc/m2/ChangeLog:
PR modula2/122407
* gm2-compiler/FilterError.def (Copyright): Use correct
licence.
* gm2-compiler/FilterError.mod (Copyright): Ditto.
* gm2-compiler/M2Quads.mod (BuildNewProcedure): Rewrite.
(BuildIncProcedure): Ditto.
(BuildDecProcedure): Ditto.
(BuildInclProcedure): Ditto.
(BuildExclProcedure): Ditto.
(BuildAbsFunction): Ditto.
(BuildCapFunction): Ditto.
(BuildChrFunction): Ditto.
(BuildOrdFunction): Ditto.
(BuildIntFunction): Ditto.
(BuildMinFunction): Ditto.
(BuildMaxFunction): Ditto.
(BuildTruncFunction): Ditto.
(BuildTBitSizeFunction): Ditto.
(BuildTSizeFunction): Ditto.
(BuildSizeFunction): Ditto.
gcc/testsuite/ChangeLog:
PR modula2/122407
* gm2.dg/spell/iso/fail/badspellabs.mod: New test.
* gm2.dg/spell/iso/fail/badspelladr.mod: New test.
* gm2.dg/spell/iso/fail/badspellcap.mod: New test.
* gm2.dg/spell/iso/fail/badspellchr.mod: New test.
* gm2.dg/spell/iso/fail/badspellchr2.mod: New test.
* gm2.dg/spell/iso/fail/badspelldec.mod: New test.
* gm2.dg/spell/iso/fail/badspellexcl.mod: New test.
* gm2.dg/spell/iso/fail/badspellinc.mod: New test.
* gm2.dg/spell/iso/fail/badspellincl.mod: New test.
* gm2.dg/spell/iso/fail/badspellnew.mod: New test.
* gm2.dg/spell/iso/fail/badspellsize.mod: New test.
* gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp: New test.
Signed-off-by: Gaius Mulley <[email protected]>
---
gcc/m2/gm2-compiler/FilterError.def | 11 +-
gcc/m2/gm2-compiler/FilterError.mod | 13 +-
gcc/m2/gm2-compiler/M2Quads.mod | 204 ++++++++++--------
.../gm2.dg/spell/iso/fail/badspellabs.mod | 14 ++
.../gm2.dg/spell/iso/fail/badspelladr.mod | 16 ++
.../gm2.dg/spell/iso/fail/badspellcap.mod | 13 ++
.../gm2.dg/spell/iso/fail/badspellchr.mod | 13 ++
.../gm2.dg/spell/iso/fail/badspellchr2.mod | 13 ++
.../gm2.dg/spell/iso/fail/badspelldec.mod | 11 +
.../gm2.dg/spell/iso/fail/badspellexcl.mod | 11 +
.../gm2.dg/spell/iso/fail/badspellinc.mod | 12 ++
.../gm2.dg/spell/iso/fail/badspellincl.mod | 11 +
.../gm2.dg/spell/iso/fail/badspellnew.mod | 13 ++
.../gm2.dg/spell/iso/fail/badspellsize.mod | 14 ++
.../spell/iso/fail/dg-spell-iso-fail.exp | 34 +++
15 files changed, 294 insertions(+), 109 deletions(-)
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/badspellabs.mod
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/badspelladr.mod
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/badspellcap.mod
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr.mod
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr2.mod
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/badspelldec.mod
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/badspellexcl.mod
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/badspellinc.mod
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/badspellincl.mod
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/badspellnew.mod
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/badspellsize.mod
create mode 100644 gcc/testsuite/gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp
diff --git a/gcc/m2/gm2-compiler/FilterError.def
b/gcc/m2/gm2-compiler/FilterError.def
index ef84aef2f1f..2a8e96c2395 100644
--- a/gcc/m2/gm2-compiler/FilterError.def
+++ b/gcc/m2/gm2-compiler/FilterError.def
@@ -1,7 +1,7 @@
(* FilterError.def provides a filter for token and symbol.
Copyright (C) 2025 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <[email protected]>.
+Contributed by Gaius Mulley <[email protected]>.
This file is part of GNU Modula-2.
@@ -15,13 +15,8 @@ WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
-Under Section 7 of GPL version 3, you are granted additional
-permissions described in the GCC Runtime Library Exception, version
-3.1, as published by the Free Software Foundation.
-
-You should have received a copy of the GNU General Public License and
-a copy of the GCC Runtime Library Exception along with this program;
-see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
<http://www.gnu.org/licenses/>. *)
DEFINITION MODULE FilterError ;
diff --git a/gcc/m2/gm2-compiler/FilterError.mod
b/gcc/m2/gm2-compiler/FilterError.mod
index b2070debabe..6f2b2f3444a 100644
--- a/gcc/m2/gm2-compiler/FilterError.mod
+++ b/gcc/m2/gm2-compiler/FilterError.mod
@@ -1,7 +1,7 @@
-(* FilterError.def implements a filter for token and symbol.
+(* FilterError.mod implements a filter for token and symbol.
Copyright (C) 2025 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <[email protected]>.
+Contributed by Gaius Mulley <[email protected]>.
This file is part of GNU Modula-2.
@@ -15,13 +15,8 @@ WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
-Under Section 7 of GPL version 3, you are granted additional
-permissions described in the GCC Runtime Library Exception, version
-3.1, as published by the Free Software Foundation.
-
-You should have received a copy of the GNU General Public License and
-a copy of the GCC Runtime Library Exception along with this program;
-see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
<http://www.gnu.org/licenses/>. *)
IMPLEMENTATION MODULE FilterError ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index bacd9561a72..5ceeb4f139a 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -7244,7 +7244,8 @@ BEGIN
PushT (2) ; (* Two parameters *)
BuildProcedureCall (combinedtok)
ELSE
- MetaErrorT0 (paramtok, 'parameter to {%EkNEW} must be a pointer')
+ MetaErrorT1 (paramtok, 'parameter to {%EkNEW} must be a pointer,' +
+ ' seen {%1Ed} {%1&s}', PtrSym)
END
ELSE
MetaErrorT0 (functok, '{%E}ALLOCATE procedure not found for NEW
substitution')
@@ -7333,7 +7334,8 @@ BEGIN
PushT (2) ; (* Two parameters *)
BuildProcedureCall (combinedtok)
ELSE
- MetaErrorT0 (paramtok, 'argument to {%EkDISPOSE} must be a
pointer')
+ MetaErrorT1 (paramtok, 'argument to {%EkDISPOSE} must be a
pointer,' +
+ ' seen {%1Ed} {%1&s}', PtrSym)
END
ELSE
MetaErrorT0 (functok, '{%E}DEALLOCATE procedure not found for DISPOSE
substitution')
@@ -7442,6 +7444,7 @@ END CheckRangeIncDec ;
PROCEDURE BuildIncProcedure (proctok: CARDINAL) ;
VAR
+ vartok : CARDINAL ;
NoOfParam,
dtype,
OperandSym,
@@ -7452,6 +7455,7 @@ BEGIN
IF (NoOfParam = 1) OR (NoOfParam = 2)
THEN
VarSym := OperandT (NoOfParam) ; (* Bottom/first parameter. *)
+ vartok := OperandTok (NoOfParam) ;
IF IsVar (VarSym)
THEN
dtype := GetDType (VarSym) ;
@@ -7464,13 +7468,13 @@ BEGIN
PopT (OperandSym)
END ;
- PushTtok (VarSym, proctok) ;
- TempSym := DereferenceLValue (proctok, VarSym) ;
+ PushTtok (VarSym, vartok) ;
+ TempSym := DereferenceLValue (vartok, VarSym) ;
CheckRangeIncDec (proctok, TempSym, OperandSym, PlusTok) ; (*
TempSym + OperandSym. *)
BuildAssignmentWithoutBounds (proctok, FALSE, TRUE) (* VarSym :=
TempSym + OperandSym. *)
ELSE
- MetaErrorT1 (proctok,
- 'base procedure {%EkINC} expects a variable as a
parameter but was given {%1Ed}',
+ MetaErrorT1 (vartok,
+ 'base procedure {%EkINC} expects a variable as a
parameter but was given {%1Ed} {%1&s}',
VarSym)
END
ELSE
@@ -7513,6 +7517,7 @@ END BuildIncProcedure ;
PROCEDURE BuildDecProcedure (proctok: CARDINAL) ;
VAR
+ vartok : CARDINAL ;
NoOfParam,
dtype,
OperandSym,
@@ -7523,6 +7528,7 @@ BEGIN
IF (NoOfParam = 1) OR (NoOfParam = 2)
THEN
VarSym := OperandT (NoOfParam) ; (* Bottom/first parameter. *)
+ vartok := OperandTok (NoOfParam) ;
IF IsVar (VarSym)
THEN
dtype := GetDType (VarSym) ;
@@ -7535,13 +7541,13 @@ BEGIN
PopT (OperandSym)
END ;
- PushTtok (VarSym, proctok) ;
- TempSym := DereferenceLValue (OperandTok (NoOfParam), VarSym) ;
+ PushTtok (VarSym, vartok) ;
+ TempSym := DereferenceLValue (vartok, VarSym) ;
CheckRangeIncDec (proctok, TempSym, OperandSym, MinusTok) ; (*
TempSym - OperandSym. *)
BuildAssignmentWithoutBounds (proctok, FALSE, TRUE) (* VarSym :=
TempSym - OperandSym. *)
ELSE
- MetaErrorT1 (proctok,
- 'base procedure {%EkDEC} expects a variable as a
parameter but was given {%1Ed}',
+ MetaErrorT1 (vartok,
+ 'base procedure {%EkDEC} expects a variable as a
parameter but was given {%1Ed} {%1&s}',
VarSym)
END
ELSE
@@ -7604,6 +7610,7 @@ END DereferenceLValue ;
PROCEDURE BuildInclProcedure (proctok: CARDINAL) ;
VAR
+ vartok,
optok : CARDINAL ;
NoOfParam,
DerefSym,
@@ -7614,6 +7621,7 @@ BEGIN
IF NoOfParam = 2
THEN
VarSym := OperandT (2) ;
+ vartok := OperandTok (2) ;
MarkArrayWritten (OperandA (2)) ;
OperandSym := OperandT (1) ;
optok := OperandTok (1) ;
@@ -7625,14 +7633,14 @@ BEGIN
BuildRange (InitInclCheck (VarSym, DerefSym)) ;
GenQuadO (proctok, InclOp, VarSym, NulSym, DerefSym, FALSE)
ELSE
- MetaErrorT1 (proctok,
- 'the first parameter to {%EkINCL} must be a set
variable but is {%1Ed}',
- VarSym)
+ MetaErrorT1 (vartok,
+ 'the first parameter to {%EkINCL} must be a set
variable,' +
+ ' seen {%1Ed} {%1&s}', VarSym)
END
ELSE
- MetaErrorT1 (proctok,
- 'base procedure {%EkINCL} expects a variable as a
parameter but is {%1Ed}',
- VarSym)
+ MetaErrorT1 (vartok,
+ 'base procedure {%EkINCL} expects a variable as a
parameter,' +
+ ' seen {%1Ed} {%1&s}', VarSym)
END
ELSE
MetaErrorT0 (proctok, 'the base procedure {%EkINCL} expects 1 or 2
parameters')
@@ -7668,6 +7676,7 @@ END BuildInclProcedure ;
PROCEDURE BuildExclProcedure (proctok: CARDINAL) ;
VAR
+ vartok,
optok : CARDINAL ;
NoOfParam,
DerefSym,
@@ -7678,6 +7687,7 @@ BEGIN
IF NoOfParam=2
THEN
VarSym := OperandT (2) ;
+ vartok := OperandTok (2) ;
MarkArrayWritten (OperandA(2)) ;
OperandSym := OperandT (1) ;
optok := OperandTok (1) ;
@@ -7689,14 +7699,14 @@ BEGIN
BuildRange (InitExclCheck (VarSym, DerefSym)) ;
GenQuadO (proctok, ExclOp, VarSym, NulSym, DerefSym, FALSE)
ELSE
- MetaErrorT1 (proctok,
- 'the first parameter to {%EkEXCL} must be a set
variable but is {%1Ed}',
- VarSym)
+ MetaErrorT1 (vartok,
+ 'the first parameter to {%EkEXCL} must be a set
variable,'
+ + ' seen {%1Ed} {%1&s}', VarSym)
END
ELSE
- MetaErrorT1 (proctok,
- 'base procedure {%EkEXCL} expects a variable as a
parameter but is {%1Ed}',
- VarSym)
+ MetaErrorT1 (vartok,
+ 'base procedure {%EkEXCL} expects a variable as a
parameter,' +
+ ' seen {%1Ed} {%1&s}', VarSym)
END
ELSE
MetaErrorT0 (proctok,
@@ -7986,7 +7996,7 @@ BEGIN
proctok := OperandTok (NoOfParam+1) ;
IF NOT IsAModula2Type (ProcSym)
THEN
- MetaError1 ('coersion expecting a type, seen {%1Ea} which is {%1Ed}',
ProcSym)
+ MetaError1 ('coersion expecting a type, seen {%1Ea} which is {%1Ed}
{%1&s}', ProcSym)
END ;
IF NoOfParam = 1
THEN
@@ -8674,7 +8684,7 @@ BEGIN
IF ConstExpr AND IsVar (Var)
THEN
MetaErrorT2 (optok,
- 'the procedure function {%1Ea} is being called from within
a constant expression and therefore the parameter {%2a} must be a constant,
seen a {%2dav}',
+ 'the procedure function {%1Ea} is being called from within
a constant expression and therefore the parameter {%2a} must be a constant,
seen a {%2dav} {%2&s}',
Func, Var) ;
RETURN TRUE
ELSE
@@ -8884,7 +8894,7 @@ BEGIN
PushTtok (Res, combinedtok)
ELSE
MetaErrorT1 (optok,
- 'the parameter to {%1EkODD} must be a variable or
constant, seen {%1ad}',
+ 'the parameter to {%1EkODD} must be a variable or
constant, seen {%1ad} {%1&s}',
Var) ;
PushTtok (False, combinedtok)
END
@@ -8963,13 +8973,13 @@ BEGIN
PushTFtok (Res, GetSType (Var), combinedtok)
ELSE
MetaErrorT1 (vartok,
- 'the parameter to {%AkABS} must be a variable or
constant, seen {%1ad}',
- Var)
+ 'the parameter to {%AkABS} must be a variable or
constant,' +
+ ' seen {%1ad} {%1&s}', Var)
END
ELSE
MetaErrorT1 (functok,
- 'the pseudo procedure {%AkABS} only has one parameter, seen
{%1n} parameters',
- NoOfParam)
+ 'the pseudo procedure {%AkABS} only has one parameter,' +
+ ' seen {%1n} parameters', NoOfParam)
END
END BuildAbsFunction ;
@@ -9027,13 +9037,13 @@ BEGIN
PushTFtok (Res, Char, combinedtok)
ELSE
MetaErrorT1 (optok,
- 'the parameter to {%AkCAP} must be a variable or
constant, seen {%1ad}',
- Var)
+ 'the parameter to {%AkCAP} must be a variable or
constant,' +
+ ' seen {%1ad} {%1&s}', Var)
END
ELSE
MetaErrorT1 (functok,
- 'the pseudo procedure {%AkCAP} only has one parameter, seen
{%1n} parameters',
- NoOfParam)
+ 'the pseudo procedure {%AkCAP} only has one parameter,' +
+ ' seen {%1n} parameters', NoOfParam)
END
END BuildCapFunction ;
@@ -9106,13 +9116,13 @@ BEGIN
BuildConvertFunction (Convert, ConstExpr)
ELSE
MetaErrorT1 (optok,
- 'the parameter to {%AkCHR} must be a variable or
constant, seen {%1ad}',
- Var)
+ 'the parameter to {%AkCHR} must be a variable or
constant,' +
+ ' seen {%1ad} {%1&s}', Var)
END
ELSE
MetaErrorT1 (functok,
- 'the pseudo procedure {%AkCHR} only has one parameter, seen
{%1n} parameters',
- NoOfParam)
+ 'the pseudo procedure {%AkCHR} only has one parameter,' +
+ ' seen {%1n} parameters', NoOfParam)
END
END BuildChrFunction ;
@@ -9186,13 +9196,14 @@ BEGIN
BuildConvertFunction (Convert, ConstExpr)
ELSE
MetaErrorT2 (optok,
- 'the parameter to {%1Aa} must be a variable or constant,
seen {%2ad}',
+ 'the parameter to {%1Aa} must be a variable or
constant,' +
+ ' seen {%2ad} {%2&s}',
Sym, Var)
END
ELSE
MetaErrorT2 (functok,
- 'the pseudo procedure {%1Aa} only has one parameter, seen
{%2n} parameters',
- Sym, NoOfParam)
+ 'the pseudo procedure {%1Aa} only has one parameter,' +
+ ' seen {%2n} parameters', Sym, NoOfParam)
END
END BuildOrdFunction ;
@@ -9265,14 +9276,14 @@ BEGIN
ELSE
combinedtok := MakeVirtualTok (functok, optok, optok) ;
MetaErrorT2 (optok,
- 'the parameter to {%1Ea} must be a variable or constant,
seen {%2ad}',
- Sym, Var) ;
+ 'the parameter to {%1Ea} must be a variable or
constant,' +
+ ' seen {%2ad} {%2&s}', Sym, Var) ;
PushTtok (combinedtok, MakeConstLit (combinedtok, MakeKey ('0'),
ZType))
END
ELSE
MetaErrorT2 (functok,
- 'the pseudo procedure {%1Ea} only has one parameter, seen
{%2n} parameters',
- Sym, NoOfParam) ;
+ 'the pseudo procedure {%1Ea} only has one parameter,' +
+ ' seen {%2n} parameters', Sym, NoOfParam) ;
PushTtok (functok, MakeConstLit (functok, MakeKey ('0'), ZType))
END
END BuildIntFunction ;
@@ -9338,7 +9349,8 @@ BEGIN
AreConst := FALSE ;
ELSIF NOT IsConst (OperandT (i))
THEN
- MetaError1 ('problem in the {%1EN} argument for {%kMAKEADR}, all
arguments to {%kMAKEADR} must be either variables or constants', i)
+ MetaError1 ('problem in the {%1EN} argument for {%kMAKEADR},' +
+ ' all arguments to {%kMAKEADR} must be either
variables or constants', i)
END ;
INC (i)
END ;
@@ -9350,7 +9362,8 @@ BEGIN
PopN (NoOfParameters+1) ;
PushTFtok (ReturnVar, GetSType (MakeAdr), resulttok)
ELSE
- MetaError1 ('the pseudo procedure {%EkMAKEADR} requires at least one
parameter, seen {%1n}', NoOfParameters) ;
+ MetaError1 ('the pseudo procedure {%EkMAKEADR} requires at least one
parameter,' +
+ ' seen {%1n}', NoOfParameters) ;
PopN (1) ;
PushTFtok (Nil, GetSType (MakeAdr), functok)
END
@@ -9422,15 +9435,16 @@ BEGIN
PushTFtok (returnVar, GetSType (varSet), combinedtok)
ELSE
MetaErrorT1 (vartok,
- 'SYSTEM procedure {%1EkSHIFT} expects a constant or
variable which has a type of SET as its first parameter, seen {%1ad}',
+ 'SYSTEM procedure {%1EkSHIFT} expects a constant or
variable which has a type of SET as its first parameter,' +
+ ' seen {%1ad} {%1&s}',
varSet) ;
PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal),
Cardinal, combinedtok)
END
ELSE
combinedtok := MakeVirtualTok (functok, functok, paramtok) ;
MetaErrorT1 (functok,
- 'the pseudo procedure {%kSHIFT} requires at least two
parameters, seen {%1En}',
- NoOfParam) ;
+ 'the pseudo procedure {%kSHIFT} requires at least two
parameters,' +
+ ' seen {%1En}', NoOfParam) ;
PopN (NoOfParam + 1) ;
PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal),
Cardinal, combinedtok)
END
@@ -9499,8 +9513,8 @@ BEGIN
PushTFtok (returnVar, GetSType (varSet), combinedtok)
ELSE
MetaErrorT1 (vartok,
- 'SYSTEM procedure {%EkROTATE} expects a constant or
variable which has a type of SET as its first parameter, seen {%1ad}',
- varSet) ;
+ 'SYSTEM procedure {%EkROTATE} expects a constant or
variable which has a type of SET as its first parameter,' +
+ ' seen {%1ad} {%1&s}', varSet) ;
PushTFtok (MakeConstLit (functok, MakeKey('0'), Cardinal), Cardinal,
functok)
END
ELSE
@@ -9570,8 +9584,8 @@ BEGIN
(* Spellcheck. *)
(* It is sensible not to try and recover when we dont know the return
type. *)
MetaErrorT1 (typetok,
- 'undeclared type found in builtin procedure function
{%AkVAL} {%1ad} {%1&s}',
- Type) ;
+ 'undeclared type found in builtin procedure function' +
+ ' {%AkVAL} {%1ad} {%1&s}', Type) ;
(* Non recoverable error. *)
UnknownReported (Type)
ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr)
@@ -10001,15 +10015,15 @@ BEGIN
ELSE
(* we dont know the type therefore cannot fake a return. *)
MetaErrorT1 (vartok,
- 'parameter to {%AkMIN} must be a type or a variable,
seen {%1ad}',
- Var)
+ 'parameter to {%AkMIN} must be a type or a variable,' +
+ ' seen {%1ad} {%1&s}', Var)
(* non recoverable error. *)
END
ELSE
(* we dont know the type therefore cannot fake a return. *)
MetaErrorT1 (functok,
- 'the pseudo builtin procedure function {%AkMIN} only has
one parameter, seen {%1n}',
- NoOfParam)
+ 'the pseudo builtin procedure function {%AkMIN} only has
one parameter,' +
+ ' seen {%1n}', NoOfParam)
(* non recoverable error. *)
END
END BuildMinFunction ;
@@ -10062,15 +10076,15 @@ BEGIN
ELSE
(* we dont know the type therefore cannot fake a return. *)
MetaErrorT1 (vartok,
- 'parameter to {%AkMAX} must be a type or a variable,
seen {%1ad}',
- Var)
+ 'parameter to {%AkMAX} must be a type or a variable,' +
+ ' seen {%1ad} {%1&s}', Var)
(* non recoverable error. *) ;
END
ELSE
(* we dont know the type therefore cannot fake a return. *)
MetaErrorT1 (functok,
- 'the pseudo builtin procedure function {%AkMAX} only has
one parameter, seen {%1n}',
- NoOfParam)
+ 'the pseudo builtin procedure function {%AkMAX} only has
one parameter,' +
+ ' seen {%1n}', NoOfParam)
(* non recoverable error. *)
END
END BuildMaxFunction ;
@@ -10156,8 +10170,8 @@ BEGIN
END
ELSE
MetaErrorT2 (vartok,
- 'argument to {%1Ead} must be a variable or constant,
seen {%2ad}',
- Sym, Var) ;
+ 'argument to {%1Ead} must be a variable or constant,'
+
+ ' seen {%2ad} {%2&s}', Sym, Var) ;
PushTFtok (MakeConstLit (functok, MakeKey('0'), Type), Type,
functok)
END
ELSE
@@ -10166,7 +10180,8 @@ BEGIN
ELSE
(* we dont know the type therefore cannot fake a return. *)
MetaErrorT1 (functok,
- 'the pseudo builtin procedure function {%AkTRUNC} only has
one parameter, seen {%1n}', NoOfParam)
+ 'the pseudo builtin procedure function {%AkTRUNC} only has
one parameter,' +
+ ' seen {%1n}', NoOfParam)
(* non recoverable error. *)
END
END BuildTruncFunction ;
@@ -10323,8 +10338,8 @@ BEGIN
ELSE
PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType,
combinedtok) ;
MetaErrorT2 (vartok,
- 'the parameter to the builtin procedure function {%1Ead}
must be a constant or a variable, seen {%2ad}',
- func, Var)
+ 'the parameter to the builtin procedure function {%1Ead}
must be a constant or a variable,' +
+ ' seen {%2ad} {%2&s}', func, Var)
END
ELSE
PopN (NoOfParam+1) ; (* destroy arguments to this function *)
@@ -10399,8 +10414,8 @@ BEGIN
ELSE
PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType,
combinedtok) ;
MetaErrorT2 (vartok,
- 'the parameter to the builtin procedure function {%1Ead}
must be a constant or a variable, seen {%2ad}',
- func, Var)
+ 'the parameter to the builtin procedure function {%1Ead}
must be a constant or a variable,' +
+ ' seen {%2ad} {%2&s}', func, Var)
END
ELSE
PopN (NoOfParam+1) ; (* destroy arguments to this function *)
@@ -10489,11 +10504,13 @@ BEGIN
IF IsVar (l) OR IsConst (l)
THEN
MetaErrorT2 (functok,
- 'the builtin procedure {%1Ead} requires two parameters,
both must be variables or constants but the second parameter is {%2d}',
+ 'the builtin procedure {%1Ead} requires two parameters,'
+
+ ' both must be variables or constants but the second
parameter is {%2d}',
func, r)
ELSE
MetaErrorT2 (functok,
- 'the builtin procedure {%1Ead} requires two
parameters, both must be variables or constants but the first parameter is
{%2d}',
+ 'the builtin procedure {%1Ead} requires two
parameters,' +
+ ' both must be variables or constants but the first
parameter is {%2d}',
func, l)
END ;
PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), CType), CType,
combinedtok)
@@ -10536,7 +10553,8 @@ END BuildCmplxFunction ;
PROCEDURE BuildAdrFunction ;
VAR
- endtok,
+ param,
+ paramTok,
combinedTok,
procTok,
t,
@@ -10552,7 +10570,8 @@ BEGIN
PopT (noOfParameters) ;
procSym := OperandT (noOfParameters + 1) ;
procTok := OperandTok (noOfParameters + 1) ; (* token of procedure ADR. *)
- endtok := OperandTok (1) ; (* last parameter. *)
+ paramTok := OperandTok (1) ; (* last parameter. *)
+ param := OperandT (1) ;
combinedTok := MakeVirtualTok (procTok, procTok, endtok) ;
IF noOfParameters # 1
THEN
@@ -10560,28 +10579,29 @@ BEGIN
'SYSTEM procedure ADR expects 1 parameter') ;
PopN (noOfParameters + 1) ; (* destroy the arguments and function *)
PushTF (Nil, Address)
- ELSIF IsConstString (OperandT (1))
+ ELSIF IsConstString (param)
THEN
- returnVar := MakeLeftValue (combinedTok, OperandT (1), RightValue,
+ returnVar := MakeLeftValue (combinedTok, param, RightValue,
GetSType (procSym)) ;
PopN (noOfParameters + 1) ; (* destroy the arguments and function *)
PushTFtok (returnVar, GetSType (returnVar), combinedTok)
- ELSIF (NOT IsVar(OperandT(1))) AND (NOT IsProcedure(OperandT(1)))
+ ELSIF (NOT IsVar (param)) AND (NOT IsProcedure (param))
THEN
- MetaErrorNT0 (combinedTok,
- 'SYSTEM procedure ADR expects a variable, procedure or a
constant string as its parameter') ;
+ MetaErrorT1 (paramTok,
+ 'SYSTEM procedure ADR expects a variable, procedure or a
constant string as its parameter,' +
+ ' seen {%1Ed} {%1&s}', param) ;
PopN (noOfParameters + 1) ; (* destroy the arguments and function *)
PushTFtok (Nil, Address, combinedTok)
- ELSIF IsProcedure (OperandT (1))
+ ELSIF IsProcedure (param)
THEN
- returnVar := MakeLeftValue (combinedTok, OperandT (1), RightValue,
+ returnVar := MakeLeftValue (combinedTok, param, RightValue,
GetSType (procSym)) ;
PopN (noOfParameters + 1) ; (* destroy the arguments and function *)
PushTFtok (returnVar, GetSType (returnVar), combinedTok)
ELSE
- Type := GetSType (OperandT (1)) ;
+ Type := GetSType (param) ;
Dim := OperandD (1) ;
- MarkArrayWritten (OperandT (1)) ;
+ MarkArrayWritten (param) ;
MarkArrayWritten (OperandA (1)) ;
(* if the operand is an unbounded which has not been indexed
then we will lookup its address from the unbounded record.
@@ -10590,7 +10610,7 @@ BEGIN
IF IsUnbounded (Type) AND (Dim = 0)
THEN
(* we will reference the address field of the unbounded structure *)
- UnboundedSym := OperandT (1) ;
+ UnboundedSym := param ;
rw := OperandRW (1) ;
PushTFrw (UnboundedSym, GetSType (UnboundedSym), rw) ;
Field := GetUnboundedAddressOffset (GetSType (UnboundedSym)) ;
@@ -10614,14 +10634,14 @@ BEGIN
ELSE
returnVar := MakeTemporary (combinedTok, RightValue) ;
PutVar (returnVar, GetSType (procSym)) ;
- IF GetMode (OperandT (1)) = LeftValue
+ IF GetMode (param) = LeftValue
THEN
PutVar (returnVar, GetSType (procSym)) ;
- GenQuadO (combinedTok, ConvertOp, returnVar, GetSType (procSym),
OperandT (1), FALSE)
+ GenQuadO (combinedTok, ConvertOp, returnVar, GetSType (procSym),
param, FALSE)
ELSE
- GenQuadO (combinedTok, AddrOp, returnVar, NulSym, OperandT (1),
FALSE)
+ GenQuadO (combinedTok, AddrOp, returnVar, NulSym, param, FALSE)
END ;
- PutWriteQuad (OperandT (1), GetMode (OperandT (1)), NextQuad-1) ;
+ PutWriteQuad (param, GetMode (param), NextQuad-1) ;
rw := OperandMergeRW (1) ;
Assert (IsLegal (rw))
END ;
@@ -10710,9 +10730,9 @@ BEGIN
GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, Type, TRUE)
END
ELSE
- resulttok := functok ;
- MetaErrorT1 (resulttok,
- '{%E}SYSTEM procedure {%kSIZE} expects a variable or type
as its parameter, seen {%1Ed}',
+ paramtok := OperandTok (1) ;
+ MetaErrorT1 (paramtok,
+ '{%E}SYSTEM procedure {%kSIZE} expects a variable or type
as its parameter, seen {%1Ed} {%1&s}',
OperandT (1)) ;
ReturnVar := MakeConstLit (resulttok, MakeKey('0'), Cardinal)
END ;
@@ -10802,7 +10822,7 @@ BEGIN
ELSE
resulttok := MakeVirtualTok (functok, functok, paramtok) ;
MetaErrorT1 (resulttok,
- '{%E}SYSTEM procedure function {%kTSIZE} expects the
first parameter to be a record type, seen {%1d}',
+ '{%E}SYSTEM procedure function {%kTSIZE} expects the
first parameter to be a record type, seen {%1d} {%1&s}',
Record) ;
ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
END
@@ -10866,7 +10886,7 @@ BEGIN
GenQuadO (resulttok, StandardFunctionOp, ReturnVar, ProcSym,
OperandT(1), FALSE)
ELSE
MetaErrorT1 (resulttok,
- '{%E}SYSTEM procedure function {%kTBITSIZE} expects a
variable as its first parameter, seen {%1d}',
+ '{%E}SYSTEM procedure function {%kTBITSIZE} expects a
variable as its first parameter, seen {%1d} {%1&s}',
OperandT (1)) ;
ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
END
@@ -10889,7 +10909,7 @@ BEGIN
ELSE
resulttok := MakeVirtualTok (functok, functok, paramtok) ;
MetaErrorT1 (resulttok,
- '{%E}SYSTEM procedure function {%kTBITSIZE} expects the
first parameter to be a record type, seen {%1d}',
+ '{%E}SYSTEM procedure function {%kTBITSIZE} expects the
first parameter to be a record type, seen {%1d} {%1&s}',
Record) ;
ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
END
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellabs.mod
b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellabs.mod
new file mode 100644
index 00000000000..508d93a3ec5
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellabs.mod
@@ -0,0 +1,14 @@
+
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badspellabs ;
+
+VAR
+ foo: INTEGER ;
+BEGIN
+ IF ABS (Foo) = 1
+ (* { dg-error "the parameter to ABS must be a variable or constant, seen
'Foo', did you mean foo?" "Foo" { target *-*-* } 10 } *)
+ THEN
+ END
+END badspellabs.
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspelladr.mod
b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelladr.mod
new file mode 100644
index 00000000000..7bad81519f4
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelladr.mod
@@ -0,0 +1,16 @@
+
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badspelladr ;
+
+FROM SYSTEM IMPORT ADR ;
+
+VAR
+ foo: INTEGER ;
+BEGIN
+ IF ADR (Foo) = NIL
+ (* { dg-error "SYSTEM procedure ADR expects a variable, procedure or a
constant string as its parameter, seen unknown, did you mean foo?" "Foo" {
target *-*-* } 12 } *)
+ THEN
+ END
+END badspelladr.
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellcap.mod
b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellcap.mod
new file mode 100644
index 00000000000..8fc004cc3e3
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellcap.mod
@@ -0,0 +1,13 @@
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badspellcap ;
+
+VAR
+ foo: CHAR ;
+BEGIN
+ IF CAP (Foo) = 'A'
+ (* { dg-error "the parameter to CAP must be a variable or constant, seen
'Foo', did you mean foo?" "Foo" { target *-*-* } 9 } *)
+ THEN
+ END
+END badspellcap.
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr.mod
b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr.mod
new file mode 100644
index 00000000000..1f5beaa9533
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr.mod
@@ -0,0 +1,13 @@
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badspellchr ;
+
+VAR
+ foo: CARDINAL ;
+BEGIN
+ IF CHR (Foo) = 'A'
+ (* { dg-error "the parameter to CHR must be a variable or constant, seen
'Foo', did you mean foo?" "Foo" { target *-*-* } 9 } *)
+ THEN
+ END
+END badspellchr.
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr2.mod
b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr2.mod
new file mode 100644
index 00000000000..9808a4f7d03
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellchr2.mod
@@ -0,0 +1,13 @@
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badspellchr2 ;
+
+VAR
+ foo: CARDINAL ;
+BEGIN
+ IF CHR (Foo+1) = 'A'
+ (* { dg-error "unknown symbol 'Foo', did you mean foo?" "Foo" { target
*-*-* } 9 } *)
+ THEN
+ END
+END badspellchr2.
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspelldec.mod
b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelldec.mod
new file mode 100644
index 00000000000..0c01fefedd4
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspelldec.mod
@@ -0,0 +1,11 @@
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badspelldec ;
+
+VAR
+ foo: CARDINAL ;
+BEGIN
+ DEC (Foo)
+ (* { dg-error "base procedure DEC expects a variable as a parameter but was
given unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *)
+END badspelldec.
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellexcl.mod
b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellexcl.mod
new file mode 100644
index 00000000000..92cb93273f3
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellexcl.mod
@@ -0,0 +1,11 @@
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badspellexcl ;
+
+VAR
+ foo: BITSET ;
+BEGIN
+ EXCL (Foo, 1)
+ (* { dg-error "base procedure EXCL expects a variable as a parameter, seen
unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *)
+END badspellexcl.
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellinc.mod
b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellinc.mod
new file mode 100644
index 00000000000..1d913ec7bc2
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellinc.mod
@@ -0,0 +1,12 @@
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badspellinc ;
+
+VAR
+ foo: CARDINAL ;
+BEGIN
+ INC (Foo)
+ (* { dg-error "base procedure INC expects a variable as a parameter but was
given unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *)
+
+END badspellinc.
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellincl.mod
b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellincl.mod
new file mode 100644
index 00000000000..ddaa72796e1
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellincl.mod
@@ -0,0 +1,11 @@
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badspellincl ;
+
+VAR
+ foo: BITSET ;
+BEGIN
+ INCL (Foo, 1)
+ (* { dg-error "base procedure INCL expects a variable as a parameter, seen
unknown, did you mean foo?" "Foo" { target *-*-* } 9 } *)
+END badspellincl.
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellnew.mod
b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellnew.mod
new file mode 100644
index 00000000000..4007867449c
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellnew.mod
@@ -0,0 +1,13 @@
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badspellnew ;
+
+FROM Storage IMPORT ALLOCATE ;
+
+VAR
+ foo: POINTER TO CARDINAL ;
+BEGIN
+ NEW (Foo)
+ (* { dg-error "parameter to NEW must be a pointer, seen unknown, did you
mean foo?" "Foo" { target *-*-* } 11 } *)
+END badspellnew.
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/badspellsize.mod
b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellsize.mod
new file mode 100644
index 00000000000..6ae35a59c01
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/badspellsize.mod
@@ -0,0 +1,14 @@
+
+(* { dg-do compile } *)
+(* { dg-options "-g" } *)
+
+MODULE badspellsize ;
+
+VAR
+ foo: INTEGER ;
+BEGIN
+ IF SIZE (Foo) = NIL
+ (* { dg-error "SYSTEM procedure SIZE expects a variable or type as its
parameter, seen unknown, did you mean foo?" "Foo" { target *-*-* } 10 } *)
+ THEN
+ END
+END badspellsize.
diff --git a/gcc/testsuite/gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp
b/gcc/testsuite/gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp
new file mode 100644
index 00000000000..145d7eb6078
--- /dev/null
+++ b/gcc/testsuite/gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp
@@ -0,0 +1,34 @@
+# Copyright (C) 2025 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# Compile tests, no torture testing.
+#
+# These tests raise errors in the front end; torture testing doesn't apply.
+
+# Load support procs.
+load_lib gm2-dg.exp
+
+gm2_init_iso $srcdir/$subdir
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+
+dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] "" ""
+
+# All done.
+dg-finish
--
2.39.5
