This patch adds a token location parameter to CheckVariableAgainstKeyword
and dependants ensuring that the warning is generated from the
token associated with the variable rather than the end of the statement.
gcc/m2/ChangeLog:
PR modula2/121289
* gm2-compiler/M2Students.def (CheckVariableAgainstKeyword): New
parameter tok.
* gm2-compiler/M2Students.mod (CheckVariableAgainstKeyword): New
parameter tok.
Pass tok to PerformVariableKeywordCheck.
(PerformVariableKeywordCheck): New parameter tok.
Pass tok to MetaErrorStringT0.
* gm2-compiler/P2SymBuild.mod (BuildVariable): Pass tok to
CheckVariableAgainstKeyword.
* gm2-libs-iso/LowLong.mod (except): Replace with ...
(exceptSrc): ... this.
* gm2-libs-iso/LowReal.mod (except): Replace with ...
(exceptSrc): ... this.
* gm2-libs-iso/LowShort.mod (except): Replace with ...
(exceptSrc): ... this.
* gm2-libs-iso/Processes.mod (Wait): Replace from with fromCor.
* gm2-libs-iso/RndFile.mod (EndPos): Replace end with endP.
* gm2-libs/SCmdArgs.mod (GetArg): Replace start with startPos.
Replace end with endPos.
(NArg): Replace start with startPos.
Replace end with endPos.
gcc/testsuite/ChangeLog:
PR modula2/121289
* gm2/warnings/style/fail/badvarname.mod: New test.
* gm2/warnings/style/fail/warnings-style-fail.exp: New test.
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
---
gcc/m2/gm2-compiler/M2Students.def | 2 +-
gcc/m2/gm2-compiler/M2Students.mod | 16 ++++---
gcc/m2/gm2-compiler/P2SymBuild.mod | 2 +-
gcc/m2/gm2-libs-iso/LowLong.mod | 10 ++---
gcc/m2/gm2-libs-iso/LowReal.mod | 14 +++---
gcc/m2/gm2-libs-iso/LowShort.mod | 14 +++---
gcc/m2/gm2-libs-iso/Processes.mod | 8 ++--
gcc/m2/gm2-libs-iso/RndFile.mod | 10 ++---
gcc/m2/gm2-libs/SCmdArgs.mod | 36 ++++++++-------
.../gm2/warnings/style/fail/badvarname.mod | 14 ++++++
.../style/fail/warnings-style-fail.exp | 44 +++++++++++++++++++
11 files changed, 116 insertions(+), 54 deletions(-)
create mode 100644 gcc/testsuite/gm2/warnings/style/fail/badvarname.mod
create mode 100644
gcc/testsuite/gm2/warnings/style/fail/warnings-style-fail.exp
diff --git a/gcc/m2/gm2-compiler/M2Students.def
b/gcc/m2/gm2-compiler/M2Students.def
index 7d67a0aef3c..a3ecdcdb2f6 100644
--- a/gcc/m2/gm2-compiler/M2Students.def
+++ b/gcc/m2/gm2-compiler/M2Students.def
@@ -39,7 +39,7 @@ EXPORT QUALIFIED StudentVariableCheck,
CheckVariableAgainstKeyword ;
as a keyword except for its case.
*)
-PROCEDURE CheckVariableAgainstKeyword (name: Name) ;
+PROCEDURE CheckVariableAgainstKeyword (tok: CARDINAL; name: Name) ;
(*
diff --git a/gcc/m2/gm2-compiler/M2Students.mod
b/gcc/m2/gm2-compiler/M2Students.mod
index e539eb0757a..3df160a987c 100644
--- a/gcc/m2/gm2-compiler/M2Students.mod
+++ b/gcc/m2/gm2-compiler/M2Students.mod
@@ -25,7 +25,7 @@ IMPLEMENTATION MODULE M2Students ;
FROM SymbolTable IMPORT FinalSymbol, IsVar, IsProcedure, IsModule,
GetMainModule, IsType, NulSym, IsRecord, GetSymName,
GetNth, GetNthProcedure, GetDeclaredMod, NoOfParam ;
FROM NameKey IMPORT GetKey, WriteKey, MakeKey, IsSameExcludingCase, NulName,
makekey, KeyToCharStar ;
-FROM M2MetaError IMPORT MetaErrorString0, MetaError2 ;
+FROM M2MetaError IMPORT MetaErrorStringT0, MetaError2 ;
FROM Lists IMPORT List, InitList, IsItemInList, IncludeItemIntoList ;
FROM M2Reserved IMPORT IsReserved, toktype ;
FROM DynamicStrings IMPORT String, InitString, KillString, ToUpper,
InitStringCharStar, string, Mark, ToUpper, Dup ;
@@ -78,11 +78,11 @@ END IsNotADuplicateName ;
as a keyword except for its case.
*)
-PROCEDURE CheckVariableAgainstKeyword (name: Name) ;
+PROCEDURE CheckVariableAgainstKeyword (tok: CARDINAL; name: Name) ;
BEGIN
IF StyleChecking
THEN
- PerformVariableKeywordCheck (name)
+ PerformVariableKeywordCheck (tok, name)
END
END CheckVariableAgainstKeyword ;
@@ -91,7 +91,7 @@ END CheckVariableAgainstKeyword ;
PerformVariableKeywordCheck - performs the check and constructs the
metaerror notes if appropriate.
*)
-PROCEDURE PerformVariableKeywordCheck (name: Name) ;
+PROCEDURE PerformVariableKeywordCheck (tok: CARDINAL; name: Name) ;
VAR
upper : Name ;
token : toktype ;
@@ -105,9 +105,11 @@ BEGIN
THEN
IF IsNotADuplicateName (name)
THEN
- MetaErrorString0 (Sprintf2 (Mark (InitString ('either the identifier
has the same name as a keyword or alternatively a keyword has the wrong case
({%%K%s} and {!%%O:{%%K%s}})')),
- upperS, orig)) ;
- MetaErrorString0 (Sprintf1 (Mark (InitString ('the symbol name
{!%%O:{%%K%s}} is legal as an identifier, however as such it might cause
confusion and is considered bad programming practice')), orig))
+ MetaErrorStringT0 (tok,
+ Sprintf2 (Mark (InitString ('either the identifier
has the same name as a keyword or alternatively a keyword has the wrong case
({%%K%s} and {!%%O:{%%K%s}})')),
+ upperS, orig)) ;
+ MetaErrorStringT0 (tok,
+ Sprintf1 (Mark (InitString ('the symbol name
{!%%O:{%%K%s}} is legal as an identifier, however as such it might cause
confusion and is considered bad programming practice')), orig))
END
END ;
upperS := KillString (upperS) ;
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod
b/gcc/m2/gm2-compiler/P2SymBuild.mod
index 3bb3e4741d2..54e624f6492 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -1179,8 +1179,8 @@ BEGIN
PopT (n) ;
i := 1 ;
WHILE i <= n DO
- CheckVariableAgainstKeyword (OperandT (n+1-i)) ;
tok := OperandTok (n+1-i) ;
+ CheckVariableAgainstKeyword (tok, OperandT (n+1-i)) ;
Var := MakeVar (tok, OperandT (n+1-i)) ;
AtAddress := OperandA (n+1-i) ;
IF AtAddress # NulSym
diff --git a/gcc/m2/gm2-libs-iso/LowLong.mod b/gcc/m2/gm2-libs-iso/LowLong.mod
index 92c7d91c6fe..f6119234e87 100644
--- a/gcc/m2/gm2-libs-iso/LowLong.mod
+++ b/gcc/m2/gm2-libs-iso/LowLong.mod
@@ -182,7 +182,7 @@ BEGIN
IF n<0
THEN
(* exception raised *)
- RAISE(except, ORD(badparam),
+ RAISE(exceptSrc, ORD(badparam),
'LowLong.trunc: cannot truncate to a negative number of digits') ;
RETURN x
ELSE
@@ -230,7 +230,7 @@ BEGIN
IF n<0
THEN
(* exception raised *)
- RAISE(except, ORD(badparam),
+ RAISE(exceptSrc, ORD(badparam),
'LowLong.round: cannot round to a negative number of digits') ;
RETURN x
ELSE
@@ -287,12 +287,12 @@ END currentMode ;
PROCEDURE IsLowException () : BOOLEAN ;
BEGIN
- RETURN( IsExceptionalExecution() AND IsCurrentSource(except) )
+ RETURN( IsExceptionalExecution () AND IsCurrentSource (exceptSrc) )
END IsLowException ;
VAR
- except: ExceptionSource ;
+ exceptSrc: ExceptionSource ;
BEGIN
- AllocateSource(except)
+ AllocateSource (exceptSrc)
END LowLong.
diff --git a/gcc/m2/gm2-libs-iso/LowReal.mod b/gcc/m2/gm2-libs-iso/LowReal.mod
index 580f36bb65a..6d9ea0075b4 100644
--- a/gcc/m2/gm2-libs-iso/LowReal.mod
+++ b/gcc/m2/gm2-libs-iso/LowReal.mod
@@ -183,8 +183,8 @@ BEGIN
IF n<0
THEN
(* exception raised *)
- RAISE(except, ORD(badparam),
- 'LowReal.trunc: cannot truncate to a negative number of digits') ;
+ RAISE (exceptSrc, ORD(badparam),
+ 'LowReal.trunc: cannot truncate to a negative number of digits') ;
RETURN x
ELSE
r := dtoa(x, maxsignificant, 100, point, sign) ;
@@ -231,8 +231,8 @@ BEGIN
IF n<0
THEN
(* exception raised *)
- RAISE(except, ORD(badparam),
- 'LowReal.round: cannot round to a negative number of digits') ;
+ RAISE (exceptSrc, ORD(badparam),
+ 'LowReal.round: cannot round to a negative number of digits') ;
RETURN x
ELSE
s := RealToFloatString(x, n) ;
@@ -288,12 +288,12 @@ END currentMode ;
PROCEDURE IsLowException () : BOOLEAN ;
BEGIN
- RETURN( IsExceptionalExecution() AND IsCurrentSource(except) )
+ RETURN( IsExceptionalExecution () AND IsCurrentSource (exceptSrc) )
END IsLowException ;
VAR
- except: ExceptionSource ;
+ exceptSrc: ExceptionSource ;
BEGIN
- AllocateSource(except)
+ AllocateSource (exceptSrc)
END LowReal.
diff --git a/gcc/m2/gm2-libs-iso/LowShort.mod b/gcc/m2/gm2-libs-iso/LowShort.mod
index 8531a88e828..62e4887054b 100644
--- a/gcc/m2/gm2-libs-iso/LowShort.mod
+++ b/gcc/m2/gm2-libs-iso/LowShort.mod
@@ -183,8 +183,8 @@ BEGIN
IF n<0
THEN
(* exception raised *)
- RAISE(except, ORD(badparam),
- 'LowLong.trunc: cannot truncate to a negative number of digits') ;
+ RAISE (exceptSrc, ORD(badparam),
+ 'LowLong.trunc: cannot truncate to a negative number of digits') ;
RETURN x
ELSE
r := dtoa(x, maxsignificant, 100, point, sign) ;
@@ -231,8 +231,8 @@ BEGIN
IF n<0
THEN
(* exception raised *)
- RAISE(except, ORD(badparam),
- 'LowLong.round: cannot round to a negative number of digits') ;
+ RAISE (exceptSrc, ORD(badparam),
+ 'LowLong.round: cannot round to a negative number of digits') ;
RETURN x
ELSE
s := RealToFloatString(x, n) ;
@@ -288,12 +288,12 @@ END currentMode ;
PROCEDURE IsLowException () : BOOLEAN ;
BEGIN
- RETURN( IsExceptionalExecution() AND IsCurrentSource(except) )
+ RETURN( IsExceptionalExecution () AND IsCurrentSource (exceptSrc) )
END IsLowException ;
VAR
- except: ExceptionSource ;
+ exceptSrc: ExceptionSource ;
BEGIN
- AllocateSource(except)
+ AllocateSource (exceptSrc)
END LowShort.
diff --git a/gcc/m2/gm2-libs-iso/Processes.mod
b/gcc/m2/gm2-libs-iso/Processes.mod
index 8ef22c020cf..b0c1b69d5ea 100644
--- a/gcc/m2/gm2-libs-iso/Processes.mod
+++ b/gcc/m2/gm2-libs-iso/Processes.mod
@@ -441,7 +441,7 @@ PROCEDURE Wait ;
VAR
calling,
best : ProcessId ;
- from : COROUTINE ;
+ fromCor: COROUTINE ;
BEGIN
IF debugging
THEN
@@ -451,17 +451,17 @@ BEGIN
OnWaitingQueue (calling) ;
best := chooseProcess () ;
currentId := best ;
- from := calling^.context ;
+ fromCor := calling^.context ;
IF debugging
THEN
displayProcesses ("Wait about to perform IOTRANSFER")
END ;
- IOTRANSFER (from, currentId^.context) ;
+ IOTRANSFER (fromCor, currentId^.context) ;
IF debugging
THEN
displayProcesses ("Wait after IOTRANSFER")
END ;
- currentId^.context := from ;
+ currentId^.context := fromCor ;
currentId := calling ;
OnReadyQueue (calling) ;
IF debugging
diff --git a/gcc/m2/gm2-libs-iso/RndFile.mod b/gcc/m2/gm2-libs-iso/RndFile.mod
index e04cd8ff2ea..0a2264a955e 100644
--- a/gcc/m2/gm2-libs-iso/RndFile.mod
+++ b/gcc/m2/gm2-libs-iso/RndFile.mod
@@ -398,9 +398,9 @@ PROCEDURE EndPos (cid: ChanId): FilePos;
position after which there have been no writes.
*)
VAR
- d : DeviceTablePtr ;
- end,
- old: FilePos ;
+ d : DeviceTablePtr ;
+ endP,
+ old : FilePos ;
BEGIN
IF IsRndFile(cid)
THEN
@@ -410,9 +410,9 @@ BEGIN
old := CurrentPos(cid) ;
FIO.SetPositionFromEnd(RTio.GetFile(cid), 0) ;
checkErrno(dev, d) ;
- end := CurrentPos(cid) ;
+ endP := CurrentPos(cid) ;
FIO.SetPositionFromBeginning(RTio.GetFile(cid), old) ;
- RETURN( end )
+ RETURN( endP )
END
ELSE
RAISEdevException(cid, did, IOChan.wrongDevice,
diff --git a/gcc/m2/gm2-libs/SCmdArgs.mod b/gcc/m2/gm2-libs/SCmdArgs.mod
index ed76fc460d0..8443d5f517b 100644
--- a/gcc/m2/gm2-libs/SCmdArgs.mod
+++ b/gcc/m2/gm2-libs/SCmdArgs.mod
@@ -132,26 +132,27 @@ PROCEDURE GetArg (CmdLine: String;
VAR
i : CARDINAL ;
sn,
- start, end: INTEGER ;
+ startPos,
+ endPos : INTEGER ;
ch : CHAR ;
BEGIN
i := 0 ;
- start := 0 ;
- end := Length(CmdLine) ;
+ startPos := 0 ;
+ endPos := Length(CmdLine) ;
WHILE i<n DO
- start := skipWhite(CmdLine, start, end) ;
- sn := skipNextArg(CmdLine, start, end) ;
- IF sn<end
+ startPos := skipWhite(CmdLine, startPos, endPos) ;
+ sn := skipNextArg(CmdLine, startPos, endPos) ;
+ IF sn<endPos
THEN
- start := sn ;
+ startPos := sn ;
INC(i)
ELSE
RETURN( FALSE )
END
END ;
- start := skipWhite(CmdLine, start, end) ;
- sn := skipNextArg(CmdLine, start, end) ;
- Argi := Slice(CmdLine, start, sn) ;
+ startPos := skipWhite(CmdLine, startPos, endPos) ;
+ sn := skipNextArg(CmdLine, startPos, endPos) ;
+ Argi := Slice(CmdLine, startPos, sn) ;
RETURN( TRUE )
END GetArg ;
@@ -165,17 +166,18 @@ PROCEDURE Narg (CmdLine: String) : CARDINAL ;
VAR
n : CARDINAL ;
s,
- start, end: INTEGER ;
+ startPos,
+ endPos : INTEGER ;
BEGIN
n := 0 ;
- start := 0 ;
- end := Length(CmdLine) ;
+ startPos := 0 ;
+ endPos := Length(CmdLine) ;
LOOP
- start := skipWhite(CmdLine, start, end) ;
- s := skipNextArg(CmdLine, start, end) ;
- IF s<end
+ startPos := skipWhite(CmdLine, startPos, endPos) ;
+ s := skipNextArg(CmdLine, startPos, endPos) ;
+ IF s<endPos
THEN
- start := s ;
+ startPos := s ;
INC(n)
ELSE
RETURN( n )
diff --git a/gcc/testsuite/gm2/warnings/style/fail/badvarname.mod
b/gcc/testsuite/gm2/warnings/style/fail/badvarname.mod
new file mode 100644
index 00000000000..e589b0d740a
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/style/fail/badvarname.mod
@@ -0,0 +1,14 @@
+MODULE badvarname ;
+
+
+PROCEDURE Foo ;
+VAR
+ end: CARDINAL ;
+BEGIN
+ end := 1
+END Foo ;
+
+
+BEGIN
+ Foo
+END badvarname.
diff --git a/gcc/testsuite/gm2/warnings/style/fail/warnings-style-fail.exp
b/gcc/testsuite/gm2/warnings/style/fail/warnings-style-fail.exp
new file mode 100644
index 00000000000..f44ed80be9d
--- /dev/null
+++ b/gcc/testsuite/gm2/warnings/style/fail/warnings-style-fail.exp
@@ -0,0 +1,44 @@
+# Expect driver script for GCC Regression Tests
+# 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/>.
+
+# This file was written by Gaius Mulley (gaius.mul...@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/warnings/style/fail"
+
+global TORTURE_OPTIONS
+
+set old_options $TORTURE_OPTIONS
+set TORTURE_OPTIONS { { -O0 -g -Werror=style } }
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture-fail $testcase
+}
+
+set TORTURE_OPTIONS $old_options
--
2.39.5
