as a keyword except for its case.
*)
-PROCEDURE CheckVariableAgainstKeyword (name: Name) ;
+PROCEDURE CheckVariableAgainstKeyword (tok: CARDINAL; name: Name) ;
(*
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 ;
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 ;
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 ;
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) ;
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
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
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
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.
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) ;
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) ;
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.
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) ;
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) ;
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.
VAR
calling,
best : ProcessId ;
- from : COROUTINE ;
+ fromCor: COROUTINE ;
BEGIN
IF debugging
THEN
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
position after which there have been no writes.
*)
VAR
- d : DeviceTablePtr ;
- end,
- old: FilePos ;
+ d : DeviceTablePtr ;
+ endP,
+ old : FilePos ;
BEGIN
IF IsRndFile(cid)
THEN
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,
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 ;
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 )
--- /dev/null
+MODULE badvarname ;
+
+
+PROCEDURE Foo ;
+VAR
+ end: CARDINAL ;
+BEGIN
+ end := 1
+END Foo ;
+
+
+BEGIN
+ Foo
+END badvarname.
--- /dev/null
+# 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.mulley@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
projects / thirdparty / gcc.git / commitdiff
