https://gcc.gnu.org/g:66a53767061d3f992f1e91fdd02ea7395636cdc8
commit r16-4381-g66a53767061d3f992f1e91fdd02ea7395636cdc8 Author: Gaius Mulley <[email protected]> Date: Sat Oct 11 18:34:25 2025 +0100 PR modula2/122241 Lack of spelling hints with simple errors 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. 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]> Diff: --- 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(-) diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in index fd5193fea1da..cd4dc9f06984 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 14fea6996492..8530d65acbaa 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 5b8aafec4aa0..0ae919636c24 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 ae7dde0f9b23..c2be0ba30a43 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 000000000000..7c1d00b7b592 --- /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 000000000000..7a072ae95ece --- /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 8efed994df0b..b6defbb567a6 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 89a122b9c13b..ab4caae4e30e 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 096057eb4979..b0bb1600fd98 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 d610e78821e3..e733cfde8406 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 fefcfd4cfa32..d176bc049f40 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 000000000000..22b77ed843d6 --- /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 000000000000..e5839c13213d --- /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 000000000000..656d6cf2496c --- /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 2d763aadcb9a..d2640172f4fd 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 19bb3d99954a..933551f176bd 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 000000000000..ebeb7ad13705 --- /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 000000000000..796d317cb76b --- /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 000000000000..03e525f0486b --- /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 000000000000..374f59b15862 --- /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 000000000000..79370a00bc50 --- /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.
