modula2 Fixes to the error format specifications

This patch contains a python3 script to check the meta format error
specifications.  It also includes about 20 fixes to M2Quads.mod format
specifications.

gcc/m2/ChangeLog:

	* Make-lang.in (check-format-error): New rule.
	* gm2-compiler/M2MetaError.mod (op): Add calls InternalError if
	digits are detected.
	* gm2-compiler/M2Quads.mod (BuildForToByDo): Bugfix to format
	specifier.
	(BuildLengthFunction): Bugfix to format	specifiers.
	(BuildOddFunction): Bugfix to format specifiers.
	(BuildAbsFunction): Bugfix to format specifiers.
	(BuildCapFunction): Bugfix to format specifiers.
	(BuildChrFunction): Bugfix to format specifiers.
	(BuildOrdFunction): Bugfix to format specifiers.
	(BuildMakeAdrFunction): Bugfix to format specifiers.
	(BuildSizeFunction): Bugfix to format specifiers.
	(BuildBitSizeFunction): Bugfix to format specifiers.
	* tools-src/checkmeta.py: New file.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

4 files changed, 164 insertions, 30 deletions

diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index 973afef..252b48a 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -593,6 +593,13 @@ m2/gm2-gcc/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-gcc/%.def $(MCDEPS)
 	-test -d $(@D) || $(mkinstalldirs) $(@D)
 	$(MC) -o=$@ $(srcdir)/m2/gm2-gcc/$*.def
 
+ifeq ($(HAVE_PYTHON),yes)
+check-format-error:
+	$(PYTHON) $(srcdir)/m2/tools-src/checkmeta.py -s $(srcdir)/m2/gm2-compiler
+else
+check-format-error:
+endif
+
 # The following tables define the source files which are translated into C using mc
 # and defines the system interface C files.
 
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod
index 5f794a2..97b56cc 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -1529,7 +1529,11 @@ BEGIN
             DEC (eb.ini) |
       'u':  eb.quotes := FALSE |
       ':':  ifNonNulThen (eb, sym) ;
-            DEC (eb.ini)
+            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')
 
       ELSE
          InternalFormat (eb, 'expecting one of [akqtdnpsuCDEFKNOPQRSTUWXYZ:<>%]', __LINE__)
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 399a09f..a27c3e1 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -4411,18 +4411,18 @@ BEGIN
    IdSym := RequestSym (idtok, Id) ;
    IF NOT IsExpressionCompatible (GetSType (e1), GetSType (e2))
    THEN
-      MetaError2 ('incompatible types found in {%EkFOR} loop header, initial expression {%E1tsad} and final expression {%E2tsad}',
+      MetaError2 ('incompatible types found in {%EkFOR} loop header, initial expression {%1tsad} and final expression {%2tsad}',
                  e1, e2) ;
       CheckExpressionCompatible (idtok, GetSType (e1), GetSType (e2))
    END ;
    IF NOT IsExpressionCompatible( GetSType (e1), ByType)
    THEN
-      MetaError2 ('incompatible types found in {%EkFOR} loop header, initial expression {%E1tsad} and {%kBY} {%E2tsad}',
+      MetaError2 ('incompatible types found in {%EkFOR} loop header, initial expression {%1tsad} and {%kBY} {%2tsad}',
                   e2, BySym) ;
       CheckExpressionCompatible (e1tok, GetSType (e1), ByType)
    ELSIF NOT IsExpressionCompatible (GetSType (e2), ByType)
    THEN
-      MetaError2 ('incompatible types found in {%EkFOR} loop header, final expression {%E1tsad} and {%kBY} {%E2tsad}',
+      MetaError2 ('incompatible types found in {%EkFOR} loop header, final expression {%1tsad} and {%kBY} {%2tsad}',
                   e2, BySym) ;
       CheckExpressionCompatible (e1tok, GetSType (e2), ByType)
    END ;
@@ -8290,7 +8290,7 @@ BEGIN
    Type := GetSType (Param) ;  (* get the type from the symbol, not the stack *)
    IF NoOfParam # 1
    THEN
-      MetaErrorT1 (functok, 'base procedure {%E1kLENGTH} expects 1 parameter, seen {%1En} parameters', NoOfParam)
+      MetaErrorT1 (functok, 'base procedure {%1EkLENGTH} expects 1 parameter, seen {%1n} parameters', NoOfParam)
    END ;
    IF NoOfParam >= 1
    THEN
@@ -8333,7 +8333,7 @@ BEGIN
             PopT (NoOfParam) ;
             PopN (NoOfParam + 1) ;
             PushTtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal), combinedtok) ;
-            MetaErrorT0 (functok, 'no procedure Length found for substitution to the standard function {%E1kLENGTH} which is required to calculate non constant string lengths')
+            MetaErrorT0 (functok, 'no procedure Length found for substitution to the standard function {%1EkLENGTH} which is required to calculate non constant string lengths')
          END
       END
    ELSE
@@ -8427,13 +8427,13 @@ BEGIN
          PushTtok (Res, combinedtok)
       ELSE
          MetaErrorT1 (combinedtok,
-                      'the parameter to {%E1kODD} must be a variable or constant, seen {%E1ad}',
+                      'the parameter to {%1EkODD} must be a variable or constant, seen {%1ad}',
                       Var) ;
          PushTtok (False, combinedtok)
       END
    ELSE
       MetaErrorT1 (functok,
-                   'the pseudo procedure {%E1kODD} only has one parameter, seen {%E1n} parameters',
+                   'the pseudo procedure {%1EkODD} only has one parameter, seen {%1n} parameters',
                    NoOfParam) ;
       PushTtok (False, functok)
    END
@@ -8501,12 +8501,12 @@ BEGIN
          PushTFtok (Res, GetSType (Var), combinedtok)
       ELSE
          MetaErrorT1 (combinedtok,
-                      'the parameter to {%A1kABS} must be a variable or constant, seen {%1ad}',
+                      'the parameter to {%AkABS} must be a variable or constant, seen {%1ad}',
                       Var)
       END
    ELSE
       MetaErrorT1 (functok,
-                   'the pseudo procedure {%A1kABS} only has one parameter, seen {%E1n} parameters',
+                   'the pseudo procedure {%AkABS} only has one parameter, seen {%1n} parameters',
                    NoOfParam)
    END
 END BuildAbsFunction ;
@@ -8561,12 +8561,12 @@ BEGIN
          PushTFtok (Res, Char, combinedtok)
       ELSE
          MetaErrorT1 (functok,
-                      'the parameter to {%A1kCAP} must be a variable or constant, seen {%E1ad}',
+                      'the parameter to {%AkCAP} must be a variable or constant, seen {%1ad}',
                       Var)
       END
    ELSE
       MetaErrorT1 (functok,
-                   'the pseudo procedure {%A1kCAP} only has one parameter, seen {%E1n} parameters',
+                   'the pseudo procedure {%AkCAP} only has one parameter, seen {%1n} parameters',
                    NoOfParam)
    END
 END BuildCapFunction ;
@@ -8631,12 +8631,12 @@ BEGIN
          BuildConvertFunction
       ELSE
          MetaErrorT1 (functok,
-                      'the parameter to {%A1kCHR} must be a variable or constant, seen {%E1ad}',
+                      'the parameter to {%AkCHR} must be a variable or constant, seen {%1ad}',
                       Var)
       END
    ELSE
       MetaErrorT1 (functok,
-                   'the pseudo procedure {%A1kCHR} only has one parameter, seen {%E1n} parameters',
+                   'the pseudo procedure {%AkCHR} only has one parameter, seen {%1n} parameters',
                    NoOfParam)
    END
 END BuildChrFunction ;
@@ -8702,12 +8702,12 @@ BEGIN
          BuildConvertFunction
       ELSE
          MetaErrorT2 (functok,
-                      'the parameter to {%A1k%a} must be a variable or constant, seen {%2ad}',
+                      'the parameter to {%1Ak%a} must be a variable or constant, seen {%2ad}',
                       Sym, Var)
       END
    ELSE
       MetaErrorT2 (functok,
-                   'the pseudo procedure {%A1k%a} only has one parameter, seen {%2n} parameters',
+                   'the pseudo procedure {%1Ak%a} only has one parameter, seen {%2n} parameters',
                    Sym, NoOfParam)
    END
 END BuildOrdFunction ;
@@ -8773,13 +8773,13 @@ BEGIN
       ELSE
          combinedtok := MakeVirtualTok (functok, optok, optok) ;
          MetaErrorT2 (combinedtok,
-                      'the parameter to {%E1k%a} must be a variable or constant, seen {%2ad}',
+                      'the parameter to {%1Ek%a} must be a variable or constant, seen {%2ad}',
                       Sym, Var) ;
          PushTtok (combinedtok, MakeConstLit (combinedtok, MakeKey ('0'), ZType))
       END
    ELSE
       MetaErrorT2 (functok,
-                   'the pseudo procedure {%E1k%a} only has one parameter, seen {%2n} parameters',
+                   'the pseudo procedure {%1Ek%a} only has one parameter, seen {%2n} parameters',
                    Sym, NoOfParam) ;
       PushTtok (functok, MakeConstLit (functok, MakeKey ('0'), ZType))
    END
@@ -8846,7 +8846,7 @@ BEGIN
             AreConst := FALSE ;
          ELSIF NOT IsConst (OperandT (i))
          THEN
-            MetaError1 ('problem in the {%E1N} argument for {%EkMAKEADR}, all arguments to {%EkMAKEADR} must be either variables or constants', i)
+            MetaError1 ('problem in the {%1EN} argument for {%kMAKEADR}, all arguments to {%kMAKEADR} must be either variables or constants', i)
          END ;
          INC (i)
       END ;
@@ -8858,7 +8858,7 @@ BEGIN
       PopN (NoOfParameters+1) ;
       PushTFtok (ReturnVar, GetSType (MakeAdr), resulttok)
    ELSE
-      MetaError1 ('the pseudo procedure {%EkMAKEADR} requires at least one parameter, seen {%E1n}', NoOfParameters) ;
+      MetaError1 ('the pseudo procedure {%EkMAKEADR} requires at least one parameter, seen {%1n}', NoOfParameters) ;
       PopN (1) ;
       PushTFtok (Nil, GetSType (MakeAdr), functok)
    END
@@ -8928,14 +8928,14 @@ BEGIN
          GenQuad (LogicalShiftOp, returnVar, varSet, derefExp) ;
          PushTFtok (returnVar, GetSType (varSet), combinedtok)
       ELSE
-         MetaError1 ('SYSTEM procedure {%E1kSHIFT} expects a constant or variable which has a type of SET as its first parameter, seen {%E1ad}',
+         MetaError1 ('SYSTEM procedure {%1EkSHIFT} expects a constant or variable which has a type of SET as its first parameter, seen {%1ad}',
                      varSet) ;
          PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal), Cardinal, combinedtok)
       END
    ELSE
       combinedtok := MakeVirtualTok (functok, functok, paramtok) ;
       MetaErrorT1 (functok,
-                   'the pseudo procedure {%EkSHIFT} requires at least two parameters, seen {%E1n}',
+                   'the pseudo procedure {%kSHIFT} requires at least two parameters, seen {%1En}',
                    NoOfParam) ;
       PopN (NoOfParam + 1) ;
       PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Cardinal), Cardinal, combinedtok)
@@ -9257,12 +9257,12 @@ BEGIN
       IF IsUnknown (Type)
       THEN
          (* we cannot recover if we dont have a type.  *)
-         MetaErrorT1 (typetok, 'undeclared type {%A1ad} found in {%kCONVERT}', Type)
+         MetaErrorT1 (typetok, 'undeclared type {%1Aad} found in {%kCONVERT}', Type)
          (* non recoverable error.  *)
       ELSIF IsUnknown (Exp)
       THEN
          (* we cannot recover if we dont have a type.  *)
-         MetaErrorT1 (typetok, 'unknown {%A1d} {%1ad} found in {%kCONVERT}', Exp)
+         MetaErrorT1 (typetok, 'unknown {%1Ad} {%1ad} found in {%kCONVERT}', Exp)
          (* non recoverable error.  *)
       ELSIF (IsSet (Type) OR IsEnumeration (Type) OR IsSubrange (Type) OR
              IsType (Type) OR IsPointer (Type) OR IsProcType (Type) OR IsRecord (Type)) AND
@@ -10095,14 +10095,14 @@ BEGIN
          IF Type = NulSym
          THEN
             MetaErrorT1 (resulttok,
-                         'cannot get the type and size of {%E1ad}', OperandT (1))
+                         'cannot get the type and size of {%1Ead}', OperandT (1))
          END ;
          GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, Type, TRUE)
       END
    ELSE
       resulttok := functok ;
       MetaErrorT1 (resulttok,
-                   '{%E}SYSTEM procedure {%kSIZE} expects a variable as its parameter, seen {%E1d}',
+                   '{%E}SYSTEM procedure {%kSIZE} expects a variable as its parameter, seen {%1Ed}',
                    OperandT (1)) ;
       ReturnVar := MakeConstLit (resulttok, MakeKey('0'), Cardinal)
    END ;
@@ -10165,7 +10165,7 @@ BEGIN
          GenQuadO (resulttok, SizeOp, ReturnVar, NulSym, GetSType (OperandT (1)), FALSE)
       ELSE
          MetaErrorT1 (resulttok,
-                      '{%E}SYSTEM procedure function {%kTSIZE} expects a variable as its first parameter, seen {%E1d}',
+                      '{%E}SYSTEM procedure function {%kTSIZE} expects a variable as its first parameter, seen {%1Ed}',
                       OperandT (1)) ;
          ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
       END
@@ -10188,7 +10188,7 @@ BEGIN
       ELSE
          resulttok := MakeVirtualTok (functok, functok, paramtok) ;
          MetaErrorT1 (resulttok,
-                      '{%E}SYSTEM procedure function {%kTSIZE} expects the first parameter to be a record type, seen {%E1d}',
+                      '{%E}SYSTEM procedure function {%kTSIZE} expects the first parameter to be a record type, seen {%1d}',
                       Record) ;
          ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
       END
@@ -10252,7 +10252,7 @@ BEGIN
          GenQuadO (resulttok, StandardFunctionOp, ReturnVar, ProcSym, OperandT(1), FALSE)
       ELSE
          MetaErrorT1 (resulttok,
-                      '{%E}SYSTEM procedure function {%kTBITSIZE} expects a variable as its first parameter, seen {%E1d}',
+                      '{%E}SYSTEM procedure function {%kTBITSIZE} expects a variable as its first parameter, seen {%1d}',
                       OperandT (1)) ;
          ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
       END
@@ -10275,7 +10275,7 @@ BEGIN
       ELSE
          resulttok := MakeVirtualTok (functok, functok, paramtok) ;
          MetaErrorT1 (resulttok,
-                      '{%E}SYSTEM procedure function {%kTBITSIZE} expects the first parameter to be a record type, seen {%E1d}',
+                      '{%E}SYSTEM procedure function {%kTBITSIZE} expects the first parameter to be a record type, seen {%1d}',
                       Record) ;
          ReturnVar := MakeConstLit (resulttok, MakeKey ('0'), Cardinal)
       END
diff --git a/gcc/m2/tools-src/checkmeta.py b/gcc/m2/tools-src/checkmeta.py
new file mode 100644
index 0000000..01e5883
--- /dev/null
+++ b/gcc/m2/tools-src/checkmeta.py
@@ -0,0 +1,123 @@
+#!/usr/bin/env python3
+
+# utility to check meta errors for simple format spec mistakes.
+
+# Copyright (C) 2016-2023 Free Software Foundation, Inc.
+#
+# 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 COPYING.  If not, write to the
+# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA.
+
+import argparse
+import os
+import pathlib
+import sys
+
+
+exit_code = 0
+
+
+def visit_dir(directory, ext, func):
+    # visit_dir - call func for each file below, dir, matching extension, ext.
+    list_of_files = os.listdir(directory)
+    list_of_files.sort()
+    for filename in list_of_files:
+        path = pathlib.Path(filename)
+        full = os.path.join(directory, filename)
+        if path.suffix == ext:
+            func(full)
+
+
+def check_format_spec(filename, line, no):
+    global exit_code
+
+    percent = line.find('%')
+    if percent >= 0:
+        specifier = False
+        for ch in line[percent:]:
+            if ch in ['{', '%']:
+                pass
+            elif ch in ['1', '2', '3', '4']:
+                if specifier:
+                    sys.stderr.write('%s:%d: format specifier error, the symbol position digit must be before the specifier: %s\n' % (filename, no, line))
+                    exit_code = 1
+            else:
+                specifier = True
+
+
+def search_format(filename, line, no):
+    cbra = line.find('{')
+    while cbra >= 0:
+        colon = line.find(':', cbra)
+        end = line.find('}', cbra)
+        if end >= 0:
+            if (colon >= 0) and (colon < end):
+                end = colon
+            check_format_spec(filename, line[cbra:end], no)
+            cbra = line.find('{', end)
+        else:
+            return
+
+
+def check_string_quote (filename, line, no, quote):
+    end = line.find(quote, 1)
+    if end > 0:
+        search_format(filename, line[1:end], no)
+
+
+def check_string (filename, line, no):
+    quote = line.find("'")
+    if quote >= 0:
+        check_string_quote(filename, line[quote:], no, "'")
+    quote = line.find('"')
+    if quote >= 0:
+        check_string_quote(filename, line[quote:], no, '"')
+
+
+def check_meta_spec (filename):
+    lines = open(filename).readlines()
+    extra = 0
+    for no, line in enumerate(lines):
+        if extra > 0:
+            extra -= 1
+            check_string(filename, line, no+1)
+        elif "Meta" in line:
+            meta = line.find("Meta")
+            if meta >= 0:
+                bra = line.find("(", meta)
+                if bra >= 0:
+                    check_string(filename, line[bra:], no+1)
+            extra = 1
+
+
+def handle_arguments():
+    # handle_arguments create and return the args object.
+    parser = argparse.ArgumentParser()
+    parser.add_argument('-s', '--srcdir',
+                        help='set source directory.',
+                        default='.', action='store')
+    args = parser.parse_args()
+    return args
+
+
+def main():
+    args = handle_arguments()
+    visit_dir(args.srcdir, '.mod', check_meta_spec)
+    visit_dir(args.srcdir, '.bnf', check_meta_spec)
+    sys.exit(exit_code)
+
+
+main()