This patch introduces spell checking to Modula-2. Currently
it spell checks unknown symbols in pass 3. Unknowns found in
record fields, with statements, procedures and variable names
are checked. This is a first step in introducing spell checking
into gm2. The other passes could also benefit from spell checking
(for example module name spell checking during pass 1).
[A thank you to David Malcolm for the summary of the interface to
spell check at the Cauldron which hugely expedited this patch].
gcc/m2/ChangeLog:
PR modula2/122241
* Make-lang.in (GM2_C_OBJS): Add m2/gm2-gcc/m2spellcheck.o.
(GM2-COMP-BOOT-DEFS): Add M2StackSpell.def.
(GM2-COMP-BOOT-MODS): Add M2StackSpell.mod.
(GM2-GCC-DEFS): Add m2spellcheck.def.
(GM2-COMP-DEFS): Add M2StackSpell.def.
(GM2-COMP-MODS): Add M2StackSpell.mod.
* gm2-compiler/M2Base.mod (CheckCompatible): Add comments.
* gm2-compiler/M2MetaError.mod (importHint): New field.
(exportHint): Ditto.
(withStackHint): Ditto.
* gm2-compiler/M2Quads.mod (M2StackSpell): Import.
(BuildProcedureCall): Add spell check specifier when
encountering an unknown symbol.
(CheckProcedureParameters): Ditto.
(CheckParameter): Ditto.
(DescribeType): Ditto.
(GetQualidentImport): Ditto.
(BuildValFunction): Ditto.
(BuildCastFunction): Ditto.
(BuildConvertFunction): Ditto.
(ExpectingParameterType): Ditto.
(ExpectingVariableType): Ditto.
(BuildDesignatorPointer): Ditto.
(BuildEmptySet): Ditto.
(CheckVariableOrConstantOrProcedure): Ditto.
* gm2-compiler/P2SymBuild.mod (BuildType): Add comment.
* gm2-compiler/P3Build.bnf (SubDesignator): Reimplement.
* gm2-compiler/P3SymBuild.mod (P3StartBuildDefModule): Add
M2StackSpell.Push.
(P3StartBuildProgModule): Ditto.
(P3StartBuildImpModule): Ditto.
(StartBuildInnerModule): Ditto.
(StartBuildProcedure): Ditto.
(P3EndBuildDefModule): Add M2StackSpell.Pop.
(P3EndBuildImpModule): Ditto.
(P3EndBuildProgModule): Ditto.
(EndBuildInnerModule): Ditto.
(EndBuildProcedure): Ditto.
(BuildProcedureHeading): Ditto.
(EndBuildForward): Ditto.
* gm2-compiler/SymbolTable.mod (RequestSym): Reformat.
* gm2-gcc/init.cc (_M2_M2StackSpell_init): New prototype.
(init_PerCompilationInit): Call _M2_M2StackSpell_init.
* gm2-libs/DynamicStrings.def (RemoveWhitePrefix): Correct
comment.
* gm2-libs/DynamicStrings.mod (RemoveWhitePrefix): Ditto.
* gm2-compiler/M2StackSpell.def: New file.
* gm2-compiler/M2StackSpell.mod: New file.
* gm2-gcc/m2spellcheck.cc: New file.
* gm2-gcc/m2spellcheck.def: New file.
* gm2-gcc/m2spellcheck.h: New file.
gcc/testsuite/ChangeLog:
* gm2/iso/fail/badfield.mod: New test.
* gm2/iso/fail/badfield2.mod: New test.
* gm2/iso/fail/badprocedure.mod: New test.
* gm2/iso/fail/badprocedure2.mod: New test.
* gm2/iso/fail/badset4.mod: New test.
Signed-off-by: Gaius Mulley <[email protected]>
---
gcc/m2/Make-lang.in | 6 +
gcc/m2/gm2-compiler/M2Base.mod | 3 +
gcc/m2/gm2-compiler/M2MetaError.mod | 146 +++++++++-
gcc/m2/gm2-compiler/M2Quads.mod | 163 +++++++----
gcc/m2/gm2-compiler/M2StackSpell.def | 62 ++++
gcc/m2/gm2-compiler/M2StackSpell.mod | 280 +++++++++++++++++++
gcc/m2/gm2-compiler/P2SymBuild.mod | 1 +
gcc/m2/gm2-compiler/P3Build.bnf | 12 +-
gcc/m2/gm2-compiler/P3SymBuild.mod | 32 ++-
gcc/m2/gm2-compiler/SymbolTable.mod | 6 +-
gcc/m2/gm2-gcc/init.cc | 2 +
gcc/m2/gm2-gcc/m2spellcheck.cc | 116 ++++++++
gcc/m2/gm2-gcc/m2spellcheck.def | 66 +++++
gcc/m2/gm2-gcc/m2spellcheck.h | 45 +++
gcc/m2/gm2-libs/DynamicStrings.def | 2 +-
gcc/m2/gm2-libs/DynamicStrings.mod | 2 +-
gcc/testsuite/gm2/iso/fail/badfield.mod | 13 +
gcc/testsuite/gm2/iso/fail/badfield2.mod | 15 +
gcc/testsuite/gm2/iso/fail/badprocedure.mod | 9 +
gcc/testsuite/gm2/iso/fail/badprocedure2.mod | 21 ++
gcc/testsuite/gm2/iso/fail/badset4.mod | 8 +
21 files changed, 922 insertions(+), 88 deletions(-)
create mode 100644 gcc/m2/gm2-compiler/M2StackSpell.def
create mode 100644 gcc/m2/gm2-compiler/M2StackSpell.mod
create mode 100644 gcc/m2/gm2-gcc/m2spellcheck.cc
create mode 100644 gcc/m2/gm2-gcc/m2spellcheck.def
create mode 100644 gcc/m2/gm2-gcc/m2spellcheck.h
create mode 100644 gcc/testsuite/gm2/iso/fail/badfield.mod
create mode 100644 gcc/testsuite/gm2/iso/fail/badfield2.mod
create mode 100644 gcc/testsuite/gm2/iso/fail/badprocedure.mod
create mode 100644 gcc/testsuite/gm2/iso/fail/badprocedure2.mod
create mode 100644 gcc/testsuite/gm2/iso/fail/badset4.mod
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index fd5193fea1d..cd4dc9f0698 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -564,6 +564,7 @@ GM2_C_OBJS = m2/gm2-lang.o \
m2/gm2-gcc/m2decl.o \
m2/gm2-gcc/m2expr.o \
m2/gm2-gcc/m2linemap.o \
+ m2/gm2-gcc/m2spellcheck.o \
m2/gm2-gcc/m2statement.o \
m2/gm2-gcc/m2type.o \
m2/gm2-gcc/m2tree.o \
@@ -814,6 +815,7 @@ GM2-COMP-BOOT-DEFS = \
M2Size.def \
M2StackAddress.def \
M2StackWord.def \
+ M2StackSpell.def \
M2StateCheck.def \
M2Students.def \
M2Swig.def \
@@ -889,6 +891,7 @@ GM2-COMP-BOOT-MODS = \
M2Size.mod \
M2StackAddress.mod \
M2StackWord.mod \
+ M2StackSpell.mod \
M2StateCheck.mod \
M2Students.mod \
M2Swig.mod \
@@ -926,6 +929,7 @@ GM2-GCC-DEFS = \
m2linemap.def \
m2misc.def \
m2pp.def \
+ m2spellcheck.def \
m2statement.def \
m2top.def \
m2tree.def \
@@ -1103,6 +1107,7 @@ GM2-COMP-DEFS = \
M2Size.def \
M2StackAddress.def \
M2StackWord.def \
+ M2StackSpell.def \
M2StateCheck.def \
M2Students.def \
M2Swig.def \
@@ -1175,6 +1180,7 @@ GM2-COMP-MODS = \
M2Size.mod \
M2StackAddress.mod \
M2StackWord.mod \
+ M2StackSpell.mod \
M2StateCheck.mod \
M2Students.mod \
M2Swig.mod \
diff --git a/gcc/m2/gm2-compiler/M2Base.mod b/gcc/m2/gm2-compiler/M2Base.mod
index 14fea699649..8530d65acba 100644
--- a/gcc/m2/gm2-compiler/M2Base.mod
+++ b/gcc/m2/gm2-compiler/M2Base.mod
@@ -1214,14 +1214,17 @@ BEGIN
END ;
IF IsUnknown(t1) AND IsUnknown(t2)
THEN
+ (* --fixme-- spellcheck. *)
s := ConCat(s, InitString('two different unknown types
{%1a:{%2a:{%1a} and {%2a}}} must either be declared or imported)')) ;
MetaErrorStringT2 (tok, s, t1, t2)
ELSIF IsUnknown(t1)
THEN
+ (* --fixme-- spellcheck. *)
s := ConCat(s, InitString('this type {%1a} is currently unknown, it
must be declared or imported')) ;
MetaErrorStringT1 (tok, s, t1)
ELSIF IsUnknown(t2)
THEN
+ (* --fixme-- spellcheck. *)
s := ConCat (s, InitString('this type {%1a} is currently unknown, it
must be declared or imported')) ;
MetaErrorStringT1 (tok, s, t2)
ELSE
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod
b/gcc/m2/gm2-compiler/M2MetaError.mod
index 5b8aafec4aa..0ae919636c2 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -38,6 +38,7 @@ FROM SYSTEM IMPORT ADDRESS ;
FROM M2Error IMPORT MoveError ;
FROM M2Debug IMPORT Assert ;
FROM Storage IMPORT ALLOCATE ;
+FROM M2StackSpell IMPORT GetSpellHint ;
FROM Indexing IMPORT Index, InitIndex, KillIndex, GetIndice, PutIndice,
DeleteIndice, HighIndice ;
@@ -90,6 +91,9 @@ TYPE
len,
ini : INTEGER ;
vowel,
+ importHint,
+ exportHint,
+ withStackHint,
glyph,
chain,
root,
@@ -517,6 +521,9 @@ BEGIN
ini := 0 ;
glyph := FALSE ; (* Nothing to output yet. *)
vowel := FALSE ; (* Check for a vowel when outputing string? *)
+ importHint := FALSE;
+ exportHint := FALSE ;
+ withStackHint := FALSE ;
quotes := TRUE ;
positive := TRUE ;
root := FALSE ;
@@ -524,7 +531,7 @@ BEGIN
currentCol := findColorType (input) ;
beginCol := unsetColor ;
endCol := unsetColor ;
- stackPtr := 0
+ stackPtr := 0 ;
END
END initErrorBlock ;
@@ -558,21 +565,21 @@ BEGIN
THEN
toblock.stackPtr := fromblock.stackPtr ;
toblock.colorStack := fromblock.colorStack ;
- popColor (toblock) (* and restore the color from the push start. *)
+ popColor (toblock) (* Lastly restore the color from the push start. *)
ELSE
IF fromblock.quotes
THEN
- (* string needs to be quoted. *)
+ (* The string needs to be quoted. *)
IF toblock.currentCol = unsetColor
THEN
- (* caller has not yet assigned a color, so use the callee color at
the end. *)
+ (* The caller has not yet assigned a color, so use the callee
color at the end. *)
OutOpenQuote (toblock) ;
OutGlyphS (toblock, fromblock.out) ;
OutCloseQuote (toblock) ;
changeColor (toblock, fromblock.currentCol)
ELSE
shutdownColor (fromblock) ;
- (* caller has assigned a color, so use it after the new string. *)
+ (* The caller has assigned a color, so use it after the new
string. *)
c := toblock.currentCol ;
OutOpenQuote (toblock) ;
OutGlyphS (toblock, fromblock.out) ;
@@ -582,12 +589,12 @@ BEGIN
ELSE
IF toblock.currentCol = unsetColor
THEN
- OutGlyphS (toblock, fromblock.out) ;
+ JoinSentances (toblock, fromblock.out) ;
toblock.endCol := fromblock.endCol ;
changeColor (toblock, fromblock.endCol)
ELSE
pushColor (toblock) ;
- OutGlyphS (toblock, fromblock.out) ;
+ JoinSentances (toblock, fromblock.out) ;
toblock.endCol := fromblock.endCol ;
popColor (toblock)
END
@@ -600,7 +607,7 @@ BEGIN
toblock.chain := fromblock.chain ;
toblock.root := fromblock.root ;
toblock.ini := fromblock.ini ;
- toblock.type := fromblock.type (* might have been changed by the callee.
*)
+ toblock.type := fromblock.type (* It might have been changed by the
callee. *)
END pop ;
@@ -1714,7 +1721,8 @@ END copySym ;
(*
op := {'!'|'a'|'c'|'d'|'k'|'n'|'p'|'q'|'s'|'t'|'u'|'v'|
'A'|'B'|'C'|'D'|'E'|'F'|'G'|'H'|'K'|'M'|'N'|
- 'O'|'P'|'Q'|'R'|'S'|'T'|'U'|'V'|'W'|'X'|'Y'|'Z'} then =:
+ 'O'|'P'|'Q'|'R'|'S'|'T'|'U'|'V'|'W'|'X'|'Y'|'Z'|
+ '&' } then =:
*)
PROCEDURE op (VAR eb: errorBlock;
@@ -1768,6 +1776,8 @@ BEGIN
'X': pushOutput (eb) |
'Y': processDefine (eb) |
'Z': popOutput (eb) |
+ '&': continuation (eb, sym, bol) ;
+ DEC (eb.ini) |
':': ifNonNulThen (eb, sym) ;
DEC (eb.ini) |
'1': InternalError ('incorrect format spec, expecting %1 rather than %
spec 1') |
@@ -1788,6 +1798,42 @@ BEGIN
END op ;
+(*
+ continuation := {':'|'1'|'2'|'3'|'4'|'i'|'s'|'x'|'w'} =:
+*)
+
+PROCEDURE continuation (VAR eb: errorBlock;
+ VAR sym: ARRAY OF CARDINAL; bol: CARDINAL) ;
+BEGIN
+ Assert ((eb.ini < eb.len) AND (char (eb.in, eb.ini) = '&')) ;
+ INC (eb.ini) ;
+ WHILE (eb.ini < eb.len) AND (char (eb.in, eb.ini) # '}') DO
+ CASE char (eb.in, eb.ini) OF
+
+ ':': ifNonNulThen (eb, sym) ;
+ DEC (eb.ini) |
+ '1': InternalError ('incorrect format spec, expecting %1 rather than %
spec 1') |
+ '2': InternalError ('incorrect format spec, expecting %2 rather than %
spec 2') |
+ '3': InternalError ('incorrect format spec, expecting %3 rather than %
spec 3') |
+ '4': InternalError ('incorrect format spec, expecting %4 rather than %
spec 4') |
+ 'i': AddImportsHint (eb) |
+ 's': SpellHint (eb, sym, bol) |
+ 'x': AddExportsHint (eb) |
+ 'w': AddWithStackHint (eb)
+
+ ELSE
+ InternalFormat (eb, 'expecting one of [:1234isxw]',
+ __LINE__)
+ END ;
+ INC (eb.ini)
+ END ;
+ IF (eb.ini < eb.len) AND (char (eb.in, eb.ini) # '}')
+ THEN
+ DEC (eb.ini)
+ END
+END continuation ;
+
+
(*
percenttoken := '%' (
'1' % doOperand(1) %
@@ -1829,6 +1875,85 @@ BEGIN
END percenttoken ;
+(*
+ IsPunct - returns TRUE if ch is a punctuation character.
+*)
+
+PROCEDURE IsPunct (ch: CHAR) : BOOLEAN ;
+BEGIN
+ RETURN (ch = '.') OR (ch = ',') OR (ch = ':') OR
+ (ch = ';') OR (ch = '!') OR (ch = '(') OR
+ (ch = ')') OR (ch = '[') OR (ch = ']')
+END IsPunct ;
+
+
+(*
+ JoinSentances - join s onto eb. It removes trailing
+ spaces from eb if s starts with a punctuation
+ character.
+*)
+
+PROCEDURE JoinSentances (VAR eb: errorBlock; s: String) ;
+VAR
+ i: INTEGER ;
+BEGIN
+ IF (s # NIL) AND (Length (s) > 0)
+ THEN
+ IF IsPunct (char (s, 0))
+ THEN
+ eb.out := RemoveWhitePostfix (eb.out)
+ END ;
+ flushColor (eb) ;
+ eb.out := ConCat (eb.out, s) ;
+ eb.glyph := TRUE ;
+ eb.quotes := FALSE
+ END
+END JoinSentances ;
+
+
+(*
+ SpellHint -
+*)
+
+PROCEDURE SpellHint (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol:
CARDINAL) ;
+BEGIN
+ IF (bol <= HIGH (sym)) AND IsUnknown (sym[bol])
+ THEN
+ JoinSentances (eb, GetSpellHint (sym[bol]))
+ END
+END SpellHint ;
+
+
+(*
+ AddImportsHint -
+*)
+
+PROCEDURE AddImportsHint (VAR eb: errorBlock) ;
+BEGIN
+ eb.importHint := TRUE
+END AddImportsHint ;
+
+
+(*
+ AddExportsHint -
+*)
+
+PROCEDURE AddExportsHint (VAR eb: errorBlock) ;
+BEGIN
+ eb.exportHint := TRUE
+END AddExportsHint ;
+
+
+(*
+ AddWithStackHint -
+*)
+
+PROCEDURE AddWithStackHint (VAR eb: errorBlock) ;
+BEGIN
+ eb.withStackHint := TRUE
+END AddWithStackHint ;
+
+
(*
changeColor - changes to color, c.
*)
@@ -2166,9 +2291,10 @@ BEGIN
printf1 ("\nLength (out) = %d", l) ;
printf1 ("\nlen = %d", eb.len) ;
printf1 ("\nhighplus1 = %d", eb.highplus1) ;
- printf1 ("\nglyph = %d", eb.glyph) ;
+ (* printf1 ("\nglyph = %d", eb.glyph) ;
printf1 ("\nquotes = %d", eb.quotes) ;
printf1 ("\npositive = %d", eb.positive) ;
+ *)
printf0 ("\nbeginCol = ") ; dumpColorType (eb.beginCol) ;
printf0 ("\nendCol = ") ; dumpColorType (eb.endCol) ;
printf0 ("\ncurrentCol = ") ; dumpColorType (eb.currentCol) ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index ae7dde0f9b2..c2be0ba30a4 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -287,8 +287,7 @@ FROM M2LangDump IMPORT IsDumpRequired ;
FROM SymbolConversion IMPORT GccKnowsAbout ;
FROM M2Diagnostic IMPORT Diagnostic, InitMemDiagnostic, MemIncr, MemSet ;
-IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO ;
-
+IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO, M2StackSpell ;
CONST
DebugStackOn = TRUE ;
@@ -5405,8 +5404,10 @@ BEGIN
DisplayStack
ELSIF IsUnknown (ProcSym)
THEN
- MetaError1 ('{%1Ua} is not recognised as a procedure, check declaration
or import', ProcSym) ;
- PopN (NoOfParam + 2)
+ (* Spellcheck. *)
+ MetaError1 ('{%1Ua} is not recognised as a procedure {%1&s}', ProcSym) ;
+ PopN (NoOfParam + 2) ;
+ UnknownReported (ProcSym)
ELSE
DisplayStack ;
BuildRealProcedureCall (tokno) ;
@@ -5685,9 +5686,12 @@ BEGIN
THEN
IF IsUnknown(Proc)
THEN
- MetaError1('{%1Ua} is not recognised as a procedure, check
declaration or import', Proc)
+ (* Spellcheck. *)
+ MetaError1('{%1Ua} is not recognised as a procedure, check
declaration or import {%1&s}', Proc) ;
+ UnknownReported (Proc)
ELSE
- MetaErrors1('{%1a} is not recognised as a procedure, check
declaration or import',
+ (* --fixme-- filter on Var, Const, Procedure. *)
+ MetaErrors1('{%1a} is not recognised as a procedure, check
declaration or import {%1&s}',
'{%1Ua} is not recognised as a procedure, check
declaration or import',
Proc)
END
@@ -6041,8 +6045,9 @@ BEGIN
THEN
IF IsUnknown(FormalType)
THEN
+ (* Spellcheck. *)
FailParameter(tokpos,
- 'procedure parameter type is undeclared',
+ 'procedure parameter type is undeclared {%1&s}',
Actual, ProcSym, i) ;
RETURN
END ;
@@ -6145,10 +6150,11 @@ BEGIN
s1 := Mark(DescribeType(Type)) ;
s := ConCat(ConCat(s, Mark(InitString('] OF '))), s1)
ELSE
- IF IsUnknown(Type)
+ IF IsUnknown (Type)
THEN
+ (* Spellcheck. *)
s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Type)))) ;
- s := Sprintf1(Mark(InitString('%s (currently unknown, check
declaration or import)')),
+ s := Sprintf1(Mark(InitString('%s (currently unknown, check
declaration or import) {%1&s}')),
s1)
ELSE
s := InitStringCharStar(KeyToCharStar(GetSymName(Type)))
@@ -7805,9 +7811,11 @@ BEGIN
(* Compile time stack restored to entry state. *)
IF IsUnknown (ProcSym)
THEN
+ (* Spellcheck. *)
paramtok := OperandTtok (1) ;
combinedtok := MakeVirtual2Tok (functok, paramtok) ;
- MetaErrorT1 (functok, 'procedure function {%1Ea} is undefined', ProcSym)
;
+ MetaErrorT1 (functok, 'procedure function {%1Ea} is undefined {%1&s}',
ProcSym) ;
+ UnknownReported (ProcSym) ;
PopN (NoOfParam + 2) ;
(* Fake return value to continue compiling. *)
PushT (MakeConstLit (combinedtok, MakeKey ('0'), NulSym))
@@ -8622,6 +8630,7 @@ END BuildHighFromUnbounded ;
PROCEDURE GetQualidentImport (tokno: CARDINAL;
n: Name; module: Name) : CARDINAL ;
VAR
+ sym,
ModSym: CARDINAL ;
BEGIN
ModSym := MakeDefinitionSource (tokno, module) ;
@@ -8635,8 +8644,20 @@ BEGIN
Assert(IsDefImp(ModSym)) ;
IF (GetExported (tokno, ModSym, n)=NulSym) OR IsUnknown (GetExported
(tokno, ModSym, n))
THEN
- MetaErrorN2 ('module %a does not export procedure %a which is a
necessary component of the runtime system, hint check the path and
library/language variant',
- module, n) ;
+ sym := GetExported (tokno, ModSym, n) ;
+ IF IsUnknown (sym)
+ THEN
+ (* Spellcheck. *)
+ MetaErrorN2 ('module %a does not export procedure %a which is a
necessary component' +
+ ' of the runtime system, hint check the path and
library/language variant',
+ module, n) ;
+ MetaErrorT1 (tokno, 'unknown symbol {%1&s}', sym) ;
+ UnknownReported (sym)
+ ELSE
+ MetaErrorN2 ('module %a does not export procedure %a which is a
necessary component' +
+ ' of the runtime system, hint check the path and
library/language variant',
+ module, n)
+ END ;
FlushErrors ;
RETURN NulSym
END ;
@@ -9546,11 +9567,13 @@ BEGIN
PopTtok (ProcSym, tok) ;
IF IsUnknown (Type)
THEN
- (* not sensible to try and recover when we dont know the return type.
*)
+ (* 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}',
- Type)
- (* non recoverable error. *)
+ 'undeclared type found in builtin procedure function
{%AkVAL} {%1ad} {%1&s}',
+ Type) ;
+ (* Non recoverable error. *)
+ UnknownReported (Type)
ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr)
THEN
(* Generate fake result. *)
@@ -9638,9 +9661,11 @@ BEGIN
exptok := OperandTok (1) ;
IF IsUnknown (Type)
THEN
- (* we cannot recover if we dont have a type. *)
- MetaErrorT1 (typetok, 'undeclared type {%1Aad} found in {%kCAST}',
Type)
- (* non recoverable error. *)
+ (* Spellcheck. *)
+ (* We cannot recover if we dont have a type. *)
+ MetaErrorT1 (typetok, 'undeclared type {%1Aad} found in {%kCAST}
{%1&s}', Type) ;
+ (* Non recoverable error. *)
+ UnknownReported (Type)
ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr)
THEN
(* Generate fake result. *)
@@ -9745,14 +9770,18 @@ BEGIN
PopT (ProcSym) ;
IF IsUnknown (Type)
THEN
- (* we cannot recover if we dont have a type. *)
- MetaErrorT1 (typetok, 'undeclared type {%1Aad} found in {%kCONVERT}',
Type)
- (* non recoverable error. *)
+ (* Spellcheck. *)
+ (* We cannot recover if we dont have a type. *)
+ MetaErrorT1 (typetok, 'undeclared type {%1Aad} found in {%kCONVERT}
{%1&s}', Type) ;
+ UnknownReported (Type)
+ (* Non recoverable error. *)
ELSIF IsUnknown (Exp)
THEN
- (* we cannot recover if we dont have a type. *)
- MetaErrorT1 (typetok, 'unknown {%1Ad} {%1ad} found in {%kCONVERT}',
Exp)
- (* non recoverable error. *)
+ (* Spellcheck. *)
+ (* We cannot recover if we dont have an expression. *)
+ MetaErrorT1 (typetok, 'unknown {%1Ad} {%1ad} found in {%kCONVERT}
{%1&s}', Exp) ;
+ UnknownReported (Exp)
+ (* Non recoverable error. *)
ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr)
THEN
(* Generate fake result. *)
@@ -10879,9 +10908,18 @@ BEGIN
THEN
IF (Type = NulSym) OR IsPartialUnbounded (Type) OR IsUnknown (Type)
THEN
- MetaError1 ('the type used in the formal parameter declaration in
{%1Md} {%1a} is unknown',
- BlockSym)
+ IF IsUnknown (Type)
+ THEN
+ (* Spellcheck. *)
+ MetaError2 ('the type used in the formal parameter declaration in
{%1Md} {%1a} is unknown {%2&s}',
+ BlockSym, Type) ;
+ UnknownReported (Type)
+ ELSE
+ MetaError1 ('the type used in the formal parameter declaration in
{%1Md} {%1a} is unknown',
+ BlockSym)
+ END
ELSE
+ (* --fixme-- filter spellcheck on type. *)
MetaError2 ('the type {%1Ead} used in the formal parameter
declaration in {%2Md} {%2a} was not declared as a type',
Type, BlockSym)
END
@@ -10905,10 +10943,12 @@ BEGIN
BlockSym)
ELSIF IsPartialUnbounded(Type) OR IsUnknown(Type)
THEN
- MetaError2 ('the type {%1EMad} used during variable declaration
section in procedure {%2ad} is unknown',
+ (* Spellcheck. *)
+ MetaError2 ('the type {%1EMad} used during variable declaration
section in procedure {%2ad} is unknown {%1&s}',
Type, BlockSym) ;
MetaError2 ('the type {%1Ead} used during variable declaration
section in procedure {%2Mad} is unknown',
- Type, BlockSym)
+ Type, BlockSym) ;
+ UnknownReported (Type)
ELSE
MetaError2 ('the {%1d} {%1Ea} is not a type and therefore cannot be
used to declare a variable in {%2d} {%2a}',
Type, BlockSym)
@@ -11976,7 +12016,9 @@ BEGIN
MetaErrorT1 (ptrtok, '{%1ad} has no type and therefore cannot be
dereferenced by ^', Sym1)
ELSIF IsUnknown (Sym1)
THEN
- MetaError1 ('{%1EMad} is undefined and therefore {%1ad}^ cannot be
resolved', Sym1)
+ (* Spellcheck. *)
+ MetaError1 ('{%1EMad} is undefined and therefore {%1ad}^ cannot be
resolved {%1&s}', Sym1) ;
+ UnknownReported (Sym1)
ELSE
combinedtok := MakeVirtual2Tok (destok, ptrtok) ;
IF IsPointer (Type1)
@@ -12069,6 +12111,7 @@ BEGIN
END ;
StartScope (Type)
END ;
+ M2StackSpell.Push (Type) ;
DisplayStack ;
END StartBuildWith ;
@@ -12081,7 +12124,8 @@ PROCEDURE EndBuildWith ;
BEGIN
DisplayStack ;
EndScope ;
- PopWith
+ PopWith ;
+ M2StackSpell.Pop ;
; DisplayStack ;
END EndBuildWith ;
@@ -12154,31 +12198,37 @@ VAR
i, n, rw,
Sym, Type: CARDINAL ;
BEGIN
- n := NoOfItemsInStackAddress(WithStack) ;
+ n := NoOfItemsInStackAddress (WithStack) ;
IF (n>0) AND (NOT SuppressWith)
THEN
PopTFrwtok (Sym, Type, rw, tokpos) ;
Assert (tokpos # UnknownTokenNo) ;
- (* inner WITH always has precidence *)
- i := 1 ; (* top of stack *)
- WHILE i<=n DO
- (* WriteString('Checking for a with') ; *)
- f := PeepAddress (WithStack, i) ;
- WITH f^ DO
- IF IsRecordField (Sym) AND (GetRecord (GetParent (Sym)) =
RecordType)
- THEN
- IF IsUnused (Sym)
+ IF IsUnknown (Sym)
+ THEN
+ MetaErrorT1 (tokpos, '{%1ad} is unknown {%1&s}', Sym) ;
+ UnknownReported (Sym)
+ ELSE
+ (* Inner WITH always has precedence. *)
+ i := 1 ; (* top of stack *)
+ WHILE i<=n DO
+ (* WriteString('Checking for a with') ; *)
+ f := PeepAddress (WithStack, i) ;
+ WITH f^ DO
+ IF IsRecordField (Sym) AND (GetRecord (GetParent (Sym)) =
RecordType)
THEN
- MetaError1('record field {%1Dad} was declared as unused by a
pragma', Sym)
- END ;
- (* Fake a RecordSym.op *)
- PushTFrwtok (RecordRef, RecordType, rw, RecordTokPos) ;
- PushTFtok (Sym, Type, tokpos) ;
- BuildAccessWithField ;
- PopTFrw (Sym, Type, rw) ;
- i := n+1 (* Finish loop. *)
- ELSE
- INC (i)
+ IF IsUnused (Sym)
+ THEN
+ MetaError1('record field {%1Dad} was declared as unused
by a pragma', Sym)
+ END ;
+ (* Fake a RecordSym.op *)
+ PushTFrwtok (RecordRef, RecordType, rw, RecordTokPos) ;
+ PushTFtok (Sym, Type, tokpos) ;
+ BuildAccessWithField ;
+ PopTFrw (Sym, Type, rw) ;
+ i := n+1 (* Finish loop. *)
+ ELSE
+ INC (i)
+ END
END
END
END ;
@@ -12363,13 +12413,13 @@ BEGIN
typepos := tokpos
ELSIF IsUnknown (Type)
THEN
- n := GetSymName (Type) ;
- WriteFormat1 ('set type %a is undefined', n) ;
+ (* Spellcheck. *)
+ MetaError1 ('set type {%1a} is undefined {%1&s}', Type) ;
+ UnknownReported (Type) ;
Type := Bitset
ELSIF NOT IsSet (SkipType (Type))
THEN
- n := GetSymName (Type) ;
- WriteFormat1('expecting a set type %a', n) ;
+ MetaError1 ('expecting a set type {%1a} and not a {%1d}', Type) ;
Type := Bitset
ELSE
Type := SkipType (Type) ;
@@ -13411,7 +13461,8 @@ BEGIN
type := GetSType (sym) ;
IF IsUnknown (sym)
THEN
- MetaErrorT1 (tokpos, '{%1EUad} has not been declared', sym) ;
+ (* Spellcheck. *)
+ MetaErrorT1 (tokpos, '{%1EUad} has not been declared {%1&s}', sym) ;
UnknownReported (sym)
ELSIF IsPseudoSystemFunction (sym) OR IsPseudoBaseFunction (sym)
THEN
diff --git a/gcc/m2/gm2-compiler/M2StackSpell.def
b/gcc/m2/gm2-compiler/M2StackSpell.def
new file mode 100644
index 00000000000..7c1d00b7b59
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2StackSpell.def
@@ -0,0 +1,62 @@
+(* M2StackSpell.def definition module for M2StackSpell.mod.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <[email protected]>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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, or (at your option)
+any later version.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+DEFINITION MODULE M2StackSpell ;
+
+FROM DynamicStrings IMPORT String ;
+FROM NameKey IMPORT Name ;
+
+
+(*
+ GetSpellHint - return a string describing a spelling hint.
+*)
+
+PROCEDURE GetSpellHint (unknown: CARDINAL) : String ;
+
+
+(*
+ Push - push a scope onto the spelling stack.
+ sym might be a ModSym, DefImpSym or a varsym
+ of a record type denoting a with statement.
+*)
+
+PROCEDURE Push (sym: CARDINAL) ;
+
+
+(*
+ Pop - remove the top scope from the spelling stack.
+*)
+
+PROCEDURE Pop ;
+
+
+(*
+ GetRecordField - return the record field containing fieldName.
+ An error is generated if the fieldName is not
+ found in record.
+*)
+
+PROCEDURE GetRecordField (tokno: CARDINAL;
+ record: CARDINAL;
+ fieldName: Name) : CARDINAL ;
+
+
+END M2StackSpell.
diff --git a/gcc/m2/gm2-compiler/M2StackSpell.mod
b/gcc/m2/gm2-compiler/M2StackSpell.mod
new file mode 100644
index 00000000000..7a072ae95ec
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2StackSpell.mod
@@ -0,0 +1,280 @@
+(* M2StackSpell.mod maintain a stack of scopes used in spell checks.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <[email protected]>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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, or (at your option)
+any later version.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+IMPLEMENTATION MODULE M2StackSpell ;
+
+FROM SymbolTable IMPORT NulSym, IsModule, IsDefImp, IsRecord,
+ IsEnumeration, IsProcedure, GetNth,
+ GetSymName, GetSym, GetLocalSym,
+ UnknownReported,
+ ForeachProcedureDo, ForeachLocalSymDo,
+ ForeachFieldEnumerationDo ;
+
+FROM SymbolKey IMPORT PerformOperation ;
+FROM DynamicStrings IMPORT InitStringCharStar, InitString, Mark, string,
ConCat ;
+FROM FormatStrings IMPORT Sprintf1, Sprintf2, Sprintf3 ;
+FROM NameKey IMPORT KeyToCharStar ;
+FROM M2MetaError IMPORT MetaErrorStringT0 ;
+
+FROM M2StackWord IMPORT StackOfWord, PushWord, PopWord,
+ InitStackWord, KillStackWord,
+ NoOfItemsInStackWord, PeepWord ;
+
+FROM CDataTypes IMPORT ConstCharStar ;
+
+IMPORT m2spellcheck ;
+FROM m2spellcheck IMPORT Candidates ;
+
+
+VAR
+ DefaultStack: StackOfWord ;
+
+
+(*
+ GetRecordField - return the record field containing fieldName.
+ An error is generated if the fieldName is not
+ found in record.
+*)
+
+PROCEDURE GetRecordField (tokno: CARDINAL;
+ record: CARDINAL;
+ fieldName: Name) : CARDINAL ;
+VAR
+ str : String ;
+ sym : CARDINAL ;
+ recordName: Name ;
+ content : ConstCharStar ;
+ cand : Candidates ;
+ fieldStr,
+ recordStr,
+ contentStr: String ;
+BEGIN
+ sym := GetLocalSym (record, fieldName) ;
+ IF sym = NulSym
+ THEN
+ recordName := GetSymName (record) ;
+ content := NIL ;
+ cand := m2spellcheck.InitCandidates () ;
+ IF PushCandidates (cand, record) > 0
+ THEN
+ content := m2spellcheck.FindClosestCharStar (cand,
+ KeyToCharStar
(fieldName))
+ END ;
+ fieldStr := Mark (InitStringCharStar (KeyToCharStar (fieldName))) ;
+ recordStr := Mark (InitStringCharStar (KeyToCharStar (recordName))) ;
+ IF content = NIL
+ THEN
+ str := Sprintf2 (Mark (InitString ("field %s does not exist within
record %s")),
+ fieldStr, recordStr)
+ ELSE
+ contentStr := Mark (InitStringCharStar (content)) ;
+ str := Sprintf3 (Mark (InitString ("field %s does not exist within
record %s, did you mean %s?")),
+ fieldStr, recordStr, contentStr)
+ END ;
+ MetaErrorStringT0 (tokno, str) ;
+ m2spellcheck.KillCandidates (cand)
+ END ;
+ RETURN sym
+END GetRecordField ;
+
+
+(*
+ Push - push a scope onto the spelling stack.
+ sym might be a ModSym, DefImpSym or a varsym
+ of a record type denoting a with statement.
+*)
+
+PROCEDURE Push (sym: CARDINAL) ;
+BEGIN
+ PushWord (DefaultStack, sym)
+END Push ;
+
+
+(*
+ Pop - remove the top scope from the spelling stack.
+*)
+
+PROCEDURE Pop ;
+BEGIN
+ IF PopWord (DefaultStack) = 0
+ THEN
+ END
+END Pop ;
+
+
+VAR
+ PushCount : CARDINAL ;
+ PushCandidate: Candidates ;
+
+(*
+ PushName -
+*)
+
+PROCEDURE PushName (sym: CARDINAL) ;
+VAR
+ str: String ;
+BEGIN
+ str := InitStringCharStar (KeyToCharStar (GetSymName (sym))) ;
+ m2spellcheck.Push (PushCandidate, string (str)) ;
+ (* str := KillString (str) *)
+ INC (PushCount)
+END PushName ;
+
+
+(*
+ ForeachRecordFieldDo -
+*)
+
+PROCEDURE ForeachRecordFieldDo (record: CARDINAL; op: PerformOperation) ;
+VAR
+ i : CARDINAL ;
+ field: CARDINAL ;
+BEGIN
+ i := 1 ;
+ REPEAT
+ field := GetNth (record, i) ;
+ IF field # NulSym
+ THEN
+ op (field)
+ END ;
+ INC (i)
+ UNTIL field = NulSym
+END ForeachRecordFieldDo ;
+
+
+(*
+ PushCandidates -
+*)
+
+PROCEDURE PushCandidates (cand: Candidates; sym: CARDINAL) : CARDINAL ;
+BEGIN
+ PushCount := 0 ;
+ PushCandidate := cand ;
+ IF IsModule (sym) OR IsDefImp (sym)
+ THEN
+ ForeachProcedureDo (sym, PushName) ;
+ ForeachLocalSymDo (sym, PushName)
+ ELSIF IsEnumeration (sym)
+ THEN
+ ForeachFieldEnumerationDo (sym, PushName)
+ ELSIF IsRecord (sym)
+ THEN
+ ForeachRecordFieldDo (sym, PushName)
+ END ;
+ RETURN PushCount
+END PushCandidates ;
+
+
+(*
+ CheckForHintStr - lookup a spell hint matching misspelt. If one exists
+ then append it to HintStr. Return HintStr.
+*)
+
+PROCEDURE CheckForHintStr (sym: CARDINAL;
+ HintStr, misspelt: String) : String ;
+VAR
+ cand : Candidates ;
+ content: ConstCharStar ;
+ str : String ;
+BEGIN
+ IF IsModule (sym) OR IsDefImp (sym) OR IsProcedure (sym) OR
+ IsRecord (sym) OR IsEnumeration (sym)
+ THEN
+ cand := m2spellcheck.InitCandidates () ;
+ IF PushCandidates (cand, sym) > 1
+ THEN
+ content := m2spellcheck.FindClosestCharStar (cand, string (misspelt))
;
+ ELSE
+ content := NIL
+ END ;
+ m2spellcheck.KillCandidates (cand) ;
+ IF content # NIL
+ THEN
+ str := InitStringCharStar (content) ;
+ IF HintStr = NIL
+ THEN
+ RETURN Sprintf1 (Mark (InitString (", did you mean %s")), str)
+ ELSE
+ RETURN Sprintf2 (Mark (InitString ("%s or %s")), HintStr, str)
+ END
+ END
+ END ;
+ RETURN HintStr
+END CheckForHintStr ;
+
+
+(*
+ AddPunctuation - adds punct to the end of str providing that str is non NIL.
+*)
+
+PROCEDURE AddPunctuation (str: String; punct: ARRAY OF CHAR) : String ;
+BEGIN
+ IF str = NIL
+ THEN
+ RETURN NIL
+ ELSE
+ RETURN ConCat (str, Mark (InitString (punct)))
+ END
+END AddPunctuation ;
+
+
+(*
+ GetSpellHint - return a string describing a spelling hint.
+*)
+
+PROCEDURE GetSpellHint (unknown: CARDINAL) : String ;
+VAR
+ i, n : CARDINAL ;
+ sym : CARDINAL ;
+ misspell,
+ HintStr : String ;
+BEGIN
+ misspell := InitStringCharStar (KeyToCharStar (GetSymName (unknown))) ;
+ HintStr := NIL ;
+ n := NoOfItemsInStackWord (DefaultStack) ;
+ i := 1 ;
+ WHILE (i <= n) AND (HintStr = NIL) DO
+ sym := PeepWord (DefaultStack, i) ;
+ HintStr := CheckForHintStr (sym, HintStr, misspell) ;
+ IF IsModule (sym) OR IsDefImp (sym)
+ THEN
+ (* Cannot see beyond a module scope. *)
+ RETURN AddPunctuation (HintStr, '?')
+ END ;
+ INC (i)
+ END ;
+ RETURN AddPunctuation (HintStr, '?')
+END GetSpellHint ;
+
+
+(*
+ Init -
+*)
+
+PROCEDURE Init ;
+BEGIN
+ DefaultStack := InitStackWord ()
+END Init ;
+
+
+BEGIN
+ Init
+END M2StackSpell.
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod
b/gcc/m2/gm2-compiler/P2SymBuild.mod
index 8efed994df0..b6defbb567a 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -1284,6 +1284,7 @@ BEGIN
THEN
IF isunknown
THEN
+ (* --fixme-- spellcheck. *)
MetaError2('attempting to declare a type {%1ad} to a type
which is itself and also unknown {%2ad}',
Sym, Type)
ELSE
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index 89a122b9c13..ab4caae4e30 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -56,6 +56,7 @@ FROM M2Debug IMPORT Assert ;
FROM P2SymBuild IMPORT BuildString, BuildNumber ;
FROM M2MetaError IMPORT MetaErrorT0, MetaErrorT2 ;
FROM M2CaseList IMPORT ElseCase ;
+FROM M2StackSpell IMPORT GetRecordField ;
FROM M2Reserved IMPORT tokToTok, toktype,
NulTok, ImportTok, ExportTok, QualifiedTok,
UnQualifiedTok,
@@ -1135,16 +1136,11 @@ SubDesignator := "."
% VAR
StartScope(Type) %
Ident
%
PopTtok (name, tok) ;
-
Sym := GetLocalSym(Type, name) ;
-
IF Sym=NulSym
-
THEN
-
n1 := GetSymName(Type) ;
-
WriteFormat2('field %a does not exist within record %a', name, n1)
-
END ;
-
Type := GetType(Sym) ;
+
Sym := GetRecordField (GetTokenNo () -1, Type, name) ;
+
Type := GetType (Sym) ;
PushTFtok (Sym, Type, tok) ;
EndScope ;
-
PushT(1) ;
+
PushT (1) ;
BuildDesignatorRecord (dotpostok) %
| "[" ArrayExpList
"]"
diff --git a/gcc/m2/gm2-compiler/P3SymBuild.mod
b/gcc/m2/gm2-compiler/P3SymBuild.mod
index 096057eb497..b0bb1600fd9 100644
--- a/gcc/m2/gm2-compiler/P3SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P3SymBuild.mod
@@ -62,7 +62,9 @@ FROM M2Comp IMPORT CompilingDefinitionModule,
FROM FifoQueue IMPORT GetSubrangeFromFifoQueue ;
FROM M2Reserved IMPORT NulTok, ImportTok ;
+
IMPORT M2Error ;
+IMPORT M2StackSpell ;
(*
@@ -93,6 +95,7 @@ BEGIN
StartScope (ModuleSym) ;
Assert (IsDefImp (ModuleSym)) ;
Assert (CompilingDefinitionModule ()) ;
+ M2StackSpell.Push (ModuleSym) ;
PushT (name) ;
M2Error.EnterDefinitionScope (name)
END P3StartBuildDefModule ;
@@ -122,6 +125,7 @@ BEGIN
Assert(CompilingDefinitionModule()) ;
CheckForUnknownInModule ;
EndScope ;
+ M2StackSpell.Pop ;
PopT(NameEnd) ;
PopT(NameStart) ;
IF NameStart#NameEnd
@@ -162,7 +166,8 @@ BEGIN
Assert (IsDefImp(ModuleSym)) ;
Assert (CompilingImplementationModule()) ;
PushT (name) ;
- M2Error.EnterImplementationScope (name)
+ M2Error.EnterImplementationScope (name) ;
+ M2StackSpell.Push (ModuleSym)
END P3StartBuildImpModule ;
@@ -190,6 +195,7 @@ BEGIN
Assert(CompilingImplementationModule()) ;
CheckForUnknownInModule ;
EndScope ;
+ M2StackSpell.Pop ;
PopT(NameEnd) ;
PopT(NameStart) ;
IF NameStart#NameEnd
@@ -235,7 +241,8 @@ BEGIN
Assert(CompilingProgramModule()) ;
Assert(NOT IsDefImp(ModuleSym)) ;
PushT(name) ;
- M2Error.EnterProgramScope (name)
+ M2Error.EnterProgramScope (name) ;
+ M2StackSpell.Push (ModuleSym)
END P3StartBuildProgModule ;
@@ -273,7 +280,8 @@ BEGIN
WriteFormat0('too many errors in pass 3') ;
FlushErrors
END ;
- M2Error.LeaveErrorScope
+ M2Error.LeaveErrorScope ;
+ M2StackSpell.Pop
END P3EndBuildProgModule ;
@@ -305,7 +313,8 @@ BEGIN
Assert(NOT IsDefImp(ModuleSym)) ;
SetCurrentModule(ModuleSym) ;
PushT(name) ;
- M2Error.EnterModuleScope (name)
+ M2Error.EnterModuleScope (name) ;
+ M2StackSpell.Push (ModuleSym)
END StartBuildInnerModule ;
@@ -343,7 +352,8 @@ BEGIN
FlushErrors
END ;
SetCurrentModule(GetModuleScope(GetCurrentModule())) ;
- M2Error.LeaveErrorScope
+ M2Error.LeaveErrorScope ;
+ M2StackSpell.Pop
END EndBuildInnerModule ;
@@ -467,7 +477,8 @@ BEGIN
Assert (IsProcedure (ProcSym)) ;
PushTtok (ProcSym, tok) ;
StartScope (ProcSym) ;
- M2Error.EnterProcedureScope (name)
+ M2Error.EnterProcedureScope (name) ;
+ M2StackSpell.Push (ProcSym)
END StartBuildProcedure ;
@@ -511,7 +522,8 @@ BEGIN
FlushErrors
END ;
EndScope ;
- M2Error.LeaveErrorScope
+ M2Error.LeaveErrorScope ;
+ M2StackSpell.Pop
END EndBuildProcedure ;
@@ -545,7 +557,8 @@ BEGIN
THEN
PopT(ProcSym) ;
PopT(NameStart) ;
- EndScope
+ EndScope ;
+ M2StackSpell.Pop
END
END BuildProcedureHeading ;
@@ -558,7 +571,8 @@ PROCEDURE EndBuildForward ;
BEGIN
PopN (2) ;
EndScope ;
- M2Error.LeaveErrorScope
+ M2Error.LeaveErrorScope ;
+ M2StackSpell.Pop
END EndBuildForward ;
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod
b/gcc/m2/gm2-compiler/SymbolTable.mod
index d610e78821e..e733cfde840 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -8677,12 +8677,12 @@ BEGIN
WriteString('RequestSym for: ') ; WriteKey(SymName) ; WriteLn ;
*)
Sym := GetSym (SymName) ;
- IF Sym=NulSym
+ IF Sym = NulSym
THEN
Sym := GetSymFromUnknownTree (SymName) ;
- IF Sym=NulSym
+ IF Sym = NulSym
THEN
- (* Make unknown *)
+ (* Make unknown. *)
NewSym (Sym) ;
FillInUnknownFields (tok, Sym, SymName) ;
(* Add to unknown tree *)
diff --git a/gcc/m2/gm2-gcc/init.cc b/gcc/m2/gm2-gcc/init.cc
index fefcfd4cfa3..d176bc049f4 100644
--- a/gcc/m2/gm2-gcc/init.cc
+++ b/gcc/m2/gm2-gcc/init.cc
@@ -108,6 +108,7 @@ EXTERN void _M2_M2SymInit_init (int argc, char *argv[],
char *envp[]);
EXTERN void _M2_M2StateCheck_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_P3Build_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_M2Diagnostic_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2StackSpell_init (int argc, char *argv[], char *envp[]);
EXTERN void exit (int);
EXTERN void M2Comp_compile (const char *filename);
EXTERN void RTExceptions_DefaultErrorCatch (void);
@@ -205,6 +206,7 @@ init_PerCompilationInit (const char *filename)
_M2_M2Check_init (0, NULL, NULL);
_M2_M2LangDump_init (0, NULL, NULL);
_M2_M2StateCheck_init (0, NULL, NULL);
+ _M2_M2StackSpell_init (0, NULL, NULL);
_M2_P3Build_init (0, NULL, NULL);
M2Comp_compile (filename);
}
diff --git a/gcc/m2/gm2-gcc/m2spellcheck.cc b/gcc/m2/gm2-gcc/m2spellcheck.cc
new file mode 100644
index 00000000000..22b77ed843d
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2spellcheck.cc
@@ -0,0 +1,116 @@
+/* m2spellcheck.cc provides an interface to GCC expression trees.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <[email protected]>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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, or (at your option)
+any later version.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#define m2spellcheck_c
+#include "m2assert.h"
+#include "m2builtins.h"
+#include "m2convert.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2spellcheck.h"
+
+
+/* Define the hidden type Candidates declared in the definition module. */
+
+typedef struct Candidates_t {
+ auto_vec<const char *> candidates_array;
+ struct Candidates_t *next;
+} Candidates;
+
+
+static Candidates *freeList = NULL;
+
+
+/* InitCandidates create an empty candidate array. */
+
+void *
+m2spellcheck_InitCandidates (void)
+{
+ Candidates *c = NULL;
+ if (freeList == NULL)
+ c = (Candidates *) xmalloc (sizeof (Candidates));
+ else
+ {
+ c = freeList;
+ freeList = freeList->next;
+ }
+ memset (c, 0, sizeof (Candidates));
+ return c;
+}
+
+/* Push a string to the Candidates array.
+ The candidates array will contain str at the end. */
+
+static
+void
+Push (Candidates *cand, const char *name)
+{
+ cand->candidates_array.safe_push (name);
+}
+
+/* Push a string to the Candidates array.
+ The candidates array will contain str at the end. */
+
+void
+m2spellcheck_Push (void *cand, const char *name)
+{
+ Push (static_cast<Candidates *> (cand), name);
+}
+
+static
+void
+KillCandidates (Candidates **cand)
+{
+ // --fixme-- deallocate and zero the candidates_array.
+ (*cand)->next = freeList;
+ freeList = *cand;
+ (*cand) = NULL;
+}
+
+/* KillCandidates deallocates the candidates array and set (*cand) to NULL.
+ (*cand) is placed into the m2spellcheck module freeList. */
+
+void
+m2spellcheck_KillCandidates (void **cand)
+{
+ KillCandidates (reinterpret_cast<Candidates **> (cand));
+}
+
+/* FindClosestCharStar return the closest match to name found within
+ the candidates_array. NULL is returned if no close match is found. */
+
+const char*
+FindClosestCharStar (Candidates *cand, const char *name)
+{
+ return find_closest_string (name, &cand->candidates_array);
+}
+
+const char*
+m2spellcheck_FindClosestCharStar (void *cand, const char *name)
+{
+ return FindClosestCharStar (static_cast<Candidates *> (cand),
+ name);
+}
diff --git a/gcc/m2/gm2-gcc/m2spellcheck.def b/gcc/m2/gm2-gcc/m2spellcheck.def
new file mode 100644
index 00000000000..e5839c13213
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2spellcheck.def
@@ -0,0 +1,66 @@
+(* m2spellcheck.def definition module for m2spellcheck.cc.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <[email protected]>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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, or (at your option)
+any later version.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+DEFINITION MODULE FOR "C" m2spellcheck ;
+
+FROM CDataTypes IMPORT ConstCharStar ;
+FROM SYSTEM IMPORT ADDRESS ;
+
+
+TYPE
+ Candidates = ADDRESS ;
+
+
+(*
+ InitCandidates - create an empty candidate array.
+*)
+
+PROCEDURE InitCandidates () : Candidates ;
+
+
+(*
+ Push - push a string to the Candidates array.
+ The possibly new candidates array is returned which
+ will contain str at the end.
+*)
+
+PROCEDURE Push (cand: Candidates; str: ConstCharStar) ;
+
+
+(*
+ KillCandidates - deallocates the candidates array.
+*)
+
+PROCEDURE KillCandidates (VAR cand: Candidates) ;
+
+
+(*
+ FindClosestCharStar - return a C string which is the closest
+ string found in candidates array.
+ NIL is returned if no suitable candidate
+ is found.
+*)
+
+PROCEDURE FindClosestCharStar (cand: Candidates;
+ name: ConstCharStar) : ConstCharStar ;
+
+
+END m2spellcheck.
diff --git a/gcc/m2/gm2-gcc/m2spellcheck.h b/gcc/m2/gm2-gcc/m2spellcheck.h
new file mode 100644
index 00000000000..656d6cf2496
--- /dev/null
+++ b/gcc/m2/gm2-gcc/m2spellcheck.h
@@ -0,0 +1,45 @@
+/* m2spellcheck.h header file for m2spellcheck.cc.
+
+Copyright (C) 2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <[email protected]>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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, or (at your option)
+any later version.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#if !defined(m2spellcheck_h)
+#define m2spellcheck_h
+#if defined(m2spellcheck_c)
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__. */
+#define EXTERN
+#endif /* !__GNUG__. */
+#else /* !m2spellcheck_c. */
+#if defined(__GNUG__)
+#define EXTERN extern "C"
+#else /* !__GNUG__. */
+#define EXTERN extern
+#endif /* !__GNUG__. */
+#endif /* !m2spellcheck_c. */
+
+EXTERN void *m2spellcheck_InitCandidates (void);
+EXTERN void m2spellcheck_Push (void *cand, const char *name);
+EXTERN void m2spellcheck_KillCandidates (void **cand);
+EXTERN const char *m2spellcheck_FindClosestCharStar (void *cand,
+ const char *name);
+
+#undef EXTERN
+#endif /* m2spellcheck_h. */
diff --git a/gcc/m2/gm2-libs/DynamicStrings.def
b/gcc/m2/gm2-libs/DynamicStrings.def
index 2d763aadcb9..d2640172f4f 100644
--- a/gcc/m2/gm2-libs/DynamicStrings.def
+++ b/gcc/m2/gm2-libs/DynamicStrings.def
@@ -243,7 +243,7 @@ PROCEDURE RemoveWhitePrefix (s: String) : String ;
(*
- RemoveWhitePostfix - removes any leading white space from String, s.
+ RemoveWhitePostfix - removes any trailing white space from String, s.
A new string is returned.
*)
diff --git a/gcc/m2/gm2-libs/DynamicStrings.mod
b/gcc/m2/gm2-libs/DynamicStrings.mod
index 19bb3d99954..933551f176b 100644
--- a/gcc/m2/gm2-libs/DynamicStrings.mod
+++ b/gcc/m2/gm2-libs/DynamicStrings.mod
@@ -1692,7 +1692,7 @@ END RemoveWhitePrefix ;
(*
- RemoveWhitePostfix - removes any leading white space from String, s.
+ RemoveWhitePostfix - removes any trailing white space from String, s.
A new string is returned.
*)
diff --git a/gcc/testsuite/gm2/iso/fail/badfield.mod
b/gcc/testsuite/gm2/iso/fail/badfield.mod
new file mode 100644
index 00000000000..ebeb7ad1370
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badfield.mod
@@ -0,0 +1,13 @@
+MODULE badfield ;
+
+TYPE
+ rec = RECORD
+ xpos,
+ ypos: CARDINAL ;
+ END ;
+
+VAR
+ v: rec ;
+BEGIN
+ v.xpod := 1
+END badfield.
diff --git a/gcc/testsuite/gm2/iso/fail/badfield2.mod
b/gcc/testsuite/gm2/iso/fail/badfield2.mod
new file mode 100644
index 00000000000..796d317cb76
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badfield2.mod
@@ -0,0 +1,15 @@
+MODULE badfield2 ;
+
+TYPE
+ rec = RECORD
+ xpos,
+ ypos: CARDINAL ;
+ END ;
+
+VAR
+ v: rec ;
+BEGIN
+ WITH v DO
+ xpod := 1
+ END
+END badfield2.
diff --git a/gcc/testsuite/gm2/iso/fail/badprocedure.mod
b/gcc/testsuite/gm2/iso/fail/badprocedure.mod
new file mode 100644
index 00000000000..03e525f0486
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badprocedure.mod
@@ -0,0 +1,9 @@
+MODULE badprocedure ;
+
+PROCEDURE foo ;
+BEGIN
+END foo ;
+
+BEGIN
+ Foo
+END badprocedure.
diff --git a/gcc/testsuite/gm2/iso/fail/badprocedure2.mod
b/gcc/testsuite/gm2/iso/fail/badprocedure2.mod
new file mode 100644
index 00000000000..374f59b1586
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badprocedure2.mod
@@ -0,0 +1,21 @@
+MODULE badprocedure2 ;
+
+
+PROCEDURE foo1 ;
+BEGIN
+END foo1 ;
+
+ MODULE inner ;
+
+ IMPORT foo1 ;
+
+ PROCEDURE foo ;
+ BEGIN
+ END foo ;
+
+ BEGIN
+ Foo
+ END inner ;
+
+BEGIN
+END badprocedure2.
diff --git a/gcc/testsuite/gm2/iso/fail/badset4.mod
b/gcc/testsuite/gm2/iso/fail/badset4.mod
new file mode 100644
index 00000000000..79370a00bc5
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badset4.mod
@@ -0,0 +1,8 @@
+MODULE badset4 ;
+
+TYPE
+ foo = SET OF CHAR ;
+VAR
+ s: Foo ;
+BEGIN
+END badset4.
--
2.39.5
