https://gcc.gnu.org/g:617110ddabd97730cbc59b39d21d3e3ab8381a46
commit r16-4615-g617110ddabd97730cbc59b39d21d3e3ab8381a46 Author: Gaius Mulley <[email protected]> Date: Fri Oct 24 21:51:36 2025 +0100 PR modula2/122407: Followup to spell check remaining intrinsics 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]> Diff: --- 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 ++ .../gm2.dg/spell/iso/fail/dg-spell-iso-fail.exp | 34 ++++ 15 files changed, 294 insertions(+), 109 deletions(-) diff --git a/gcc/m2/gm2-compiler/FilterError.def b/gcc/m2/gm2-compiler/FilterError.def index ef84aef2f1f0..2a8e96c23952 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 b2070debabeb..6f2b2f3444a6 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 bacd9561a725..5ceeb4f139ad 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 000000000000..508d93a3ec59 --- /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 000000000000..7bad81519f4a --- /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 000000000000..8fc004cc3e36 --- /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 000000000000..1f5beaa9533d --- /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 000000000000..9808a4f7d03c --- /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 000000000000..0c01fefedd49 --- /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 000000000000..92cb93273f3b --- /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 000000000000..1d913ec7bc25 --- /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 000000000000..ddaa72796e1e --- /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 000000000000..4007867449c1 --- /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 000000000000..6ae35a59c01e --- /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 000000000000..145d7eb60786 --- /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
