[modula2] Location improvement and bugfix when issuing parameter errors

This patch improves the accuracy of error messages mentioning a
parameter in M2Quads.mod (when handling builtins).  The error location
now points to the parameter rather than the function or procedure.

gcc/m2/ChangeLog:

	* gm2-compiler/M2Quads.mod (BuildDifAdrFunction): Removed
	unnecessary in error message.  Use vartok for location.
	(BuildOddFunction): Use optok for location.
	(BuildAbsFunction): Use vartok for location.  Bugfix set vartok.
	(BuildCapFunction): Use optok for location.
	(BuildOrdFunction): Use optok for location and correct format
	specifier.
	(BuildShiftFunction): Use vartok for location.
	(BuildRotateFunction): Use vartok for location.
	(BuildTruncFunction): Use vartok for location.
	(BuildFloatFunction): Use vartok for location.
	(BuildReFunction): Use vartok for location.
	(BuildImFunction): Use vartok for location.
	* gm2-compiler/M2SymInit.mod (trashParam): Remove commented code.

gcc/testsuite/ChangeLog:

	* gm2/errors/fail/badabs.mod: New test.
	* gm2/errors/fail/badenum.mod: New test.

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

diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 3e4863b3bafecdd00f6dbbc383bc0f20d4df4d78..51c2835d0828823921ca098fe9d514da0105702d 100644 (file)
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -8127,22 +8127,23 @@ BEGIN
                PushT (2) ;          (* Two parameters *)
                BuildConvertFunction
             ELSE
-               MetaError1 ('the second parameter to {%EkDIFADR } {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
+               MetaError1 ('the second parameter to {%EkDIFADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
                            OperandSym) ;
                PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Integer), Integer, combinedtok)
             END
          ELSE
-            MetaError1 ('the first parameter to {%EkDIFADR } {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
-                        VarSym) ;
+            MetaErrorT1 (vartok,
+                         'the first parameter to {%EkDIFADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}',
+                         VarSym) ;
             PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Integer), Integer, combinedtok)
          END
       ELSE
-         MetaError0 ('{%E}SYSTEM procedure {%EkDIFADR } expects a variable of type ADDRESS or POINTER as its first parameter') ;
+         MetaError0 ('{%E}SYSTEM procedure {%EkDIFADR} expects a variable of type ADDRESS or POINTER as its first parameter') ;
          PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Integer), Integer, combinedtok)
       END
    ELSE
       combinedtok := MakeVirtualTok (functok, functok, optok) ;
-      MetaErrorT0 (functok, '{%E}SYSTEM procedure {%EkDIFADR } expects 2 parameters') ;
+      MetaErrorT0 (functok, '{%E}SYSTEM procedure {%EkDIFADR} expects 2 parameters') ;
       PopN (NoOfParam+1) ;
       PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Integer), Integer, combinedtok)
    END
@@ -8522,14 +8523,14 @@ BEGIN
 
          PushTtok (Res, combinedtok)
       ELSE
-         MetaErrorT1 (combinedtok,
+         MetaErrorT1 (optok,
                       'the parameter to {%1EkODD} must be a variable or constant, seen {%1ad}',
                       Var) ;
          PushTtok (False, combinedtok)
       END
    ELSE
       MetaErrorT1 (functok,
-                   'the pseudo procedure {%1EkODD} only has one parameter, seen {%1n} parameters',
+                   'the pseudo procedure {%E1kODD} only has one parameter, seen {%1n} parameters',
                    NoOfParam) ;
       PushTtok (False, functok)
    END
@@ -8573,6 +8574,7 @@ END BuildOddFunction ;
 
 PROCEDURE BuildAbsFunction ;
 VAR
+   vartok,
    functok,
    combinedtok: CARDINAL ;
    NoOfParam,
@@ -8584,6 +8586,7 @@ BEGIN
    IF NoOfParam = 1
    THEN
       Var := OperandT (1) ;
+      vartok := OperandTok (1) ;
       combinedtok := MakeVirtualTok (functok, functok, vartok) ;
       IF IsVar(Var) OR IsConst(Var)
       THEN
@@ -8596,7 +8599,7 @@ BEGIN
          GenQuadO (combinedtok, StandardFunctionOp, Res, ProcSym, Var, FALSE) ;
          PushTFtok (Res, GetSType (Var), combinedtok)
       ELSE
-         MetaErrorT1 (combinedtok,
+         MetaErrorT1 (vartok,
                       'the parameter to {%AkABS} must be a variable or constant, seen {%1ad}',
                       Var)
       END
@@ -8656,7 +8659,7 @@ BEGIN
          GenQuadO (combinedtok, StandardFunctionOp, Res, ProcSym, Var, FALSE) ;
          PushTFtok (Res, Char, combinedtok)
       ELSE
-         MetaErrorT1 (functok,
+         MetaErrorT1 (optok,
                       'the parameter to {%AkCAP} must be a variable or constant, seen {%1ad}',
                       Var)
       END
@@ -8726,7 +8729,7 @@ BEGIN
          PushT (2) ;          (* Two parameters *)
          BuildConvertFunction
       ELSE
-         MetaErrorT1 (functok,
+         MetaErrorT1 (optok,
                       'the parameter to {%AkCHR} must be a variable or constant, seen {%1ad}',
                       Var)
       END
@@ -8797,13 +8800,13 @@ BEGIN
          PushT (2) ;          (* Two parameters *)
          BuildConvertFunction
       ELSE
-         MetaErrorT2 (functok,
-                      'the parameter to {%1Ak%a} must be a variable or constant, seen {%2ad}',
+         MetaErrorT2 (optok,
+                      'the parameter to {%1Aa} must be a variable or constant, seen {%2ad}',
                       Sym, Var)
       END
    ELSE
       MetaErrorT2 (functok,
-                   'the pseudo procedure {%1Ak%a} only has one parameter, seen {%2n} parameters',
+                   'the pseudo procedure {%1Aa} only has one parameter, seen {%2n} parameters',
                    Sym, NoOfParam)
    END
 END BuildOrdFunction ;
@@ -8868,14 +8871,14 @@ BEGIN
          BuildConvertFunction
       ELSE
          combinedtok := MakeVirtualTok (functok, optok, optok) ;
-         MetaErrorT2 (combinedtok,
-                      'the parameter to {%1Ek%a} must be a variable or constant, seen {%2ad}',
+         MetaErrorT2 (optok,
+                      'the parameter to {%1Ea} must be a variable or constant, seen {%2ad}',
                       Sym, Var) ;
          PushTtok (combinedtok, MakeConstLit (combinedtok, MakeKey ('0'), ZType))
       END
    ELSE
       MetaErrorT2 (functok,
-                   'the pseudo procedure {%1Ek%a} only has one parameter, seen {%2n} parameters',
+                   'the pseudo procedure {%1Ea} only has one parameter, seen {%2n} parameters',
                    Sym, NoOfParam) ;
       PushTtok (functok, MakeConstLit (functok, MakeKey ('0'), ZType))
    END
@@ -9024,8 +9027,9 @@ BEGIN
          GenQuad (LogicalShiftOp, returnVar, varSet, derefExp) ;
          PushTFtok (returnVar, GetSType (varSet), combinedtok)
       ELSE
-         MetaError1 ('SYSTEM procedure {%1EkSHIFT} expects a constant or variable which has a type of SET as its first parameter, seen {%1ad}',
-                     varSet) ;
+         MetaErrorT1 (vartok,
+                      '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
@@ -9099,8 +9103,9 @@ BEGIN
          GenQuadO (combinedtok, LogicalRotateOp, returnVar, varSet, derefExp, TRUE) ;
          PushTFtok (returnVar, GetSType (varSet), combinedtok)
       ELSE
-         MetaErrorT0 (functok,
-                      'SYSTEM procedure {%EkROTATE} expects a constant or variable which has a type of SET as its first parameter') ;
+         MetaErrorT1 (vartok,
+                      'SYSTEM procedure {%EkROTATE} expects a constant or variable which has a type of SET as its first parameter, seen {%1ad}',
+                      varSet) ;
          PushTFtok (MakeConstLit (functok, MakeKey('0'), Cardinal), Cardinal, functok)
       END
    ELSE
@@ -9685,7 +9690,7 @@ BEGIN
                PushTFtok (MakeConstLit (functok, MakeKey('0'), Type), Type, functok)
             END
          ELSE
-            MetaErrorT2 (functok,
+            MetaErrorT2 (vartok,
                          'argument to {%1E%ad} must be a variable or constant, seen {%2ad}',
                          Sym, Var) ;
             PushTFtok (MakeConstLit (functok, MakeKey('0'), Type), Type, functok)
@@ -9764,7 +9769,7 @@ BEGIN
             PushT(2) ;          (* two parameters.  *)
             BuildConvertFunction
          ELSE
-            MetaErrorT1 (functok,
+            MetaErrorT1 (vartok,
                          'argument to {%1E%ad} must be a variable or constant', ProcSym) ;
             PushTFtok (MakeConstLit (functok, MakeKey('0.0'), Type), Type, functok)
          END
@@ -9834,7 +9839,7 @@ BEGIN
       ELSE
          PopN (NoOfParam+1) ;  (* destroy arguments to this function *)
          PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ;
-         MetaErrorT2 (functok,
+         MetaErrorT2 (vartok,
                       'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}',
                       func, Var)
       END
@@ -9902,7 +9907,7 @@ BEGIN
       ELSE
          PopN (NoOfParam+1) ;  (* destroy arguments to this function *)
          PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ;
-         MetaErrorT2 (functok,
+         MetaErrorT2 (vartok,
                       'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}',
                       func, Var)
       END

diff --git a/gcc/m2/gm2-compiler/M2SymInit.mod b/gcc/m2/gm2-compiler/M2SymInit.mod
index b7978e55ef26db106824df8ac0e3009bdfd2e134..81d1e6baf5025f71abc685d28de3906d277e285b 100644 (file)
--- a/gcc/m2/gm2-compiler/M2SymInit.mod
+++ b/gcc/m2/gm2-compiler/M2SymInit.mod
@@ -1550,8 +1550,6 @@ BEGIN
          THEN
             IF IsDeallocate (op2)
             THEN
-               (* SetupLAlias (ptr, heapSym) *)
-               (* SetupIndr (ptr, Nil) *)
                SetupLAlias (ptr, Nil)
             ELSE
                SetupIndr (ptr, heapSym)

diff --git a/gcc/testsuite/gm2/errors/fail/badabs.mod b/gcc/testsuite/gm2/errors/fail/badabs.mod
new file mode 100644 (file)
index 0000000..a7d994a
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badabs.mod
@@ -0,0 +1,7 @@
+MODULE badabs ;
+
+VAR
+   c: CARDINAL ;
+BEGIN
+   c := ABS (foo)
+END badabs.

diff --git a/gcc/testsuite/gm2/errors/fail/badenum.mod b/gcc/testsuite/gm2/errors/fail/badenum.mod
new file mode 100644 (file)
index 0000000..02b7eb2
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badenum.mod
@@ -0,0 +1,8 @@
+MODULE badenum ;
+
+TYPE
+   color = (red, blue, green) ;
+
+BEGIN
+   red := 1
+END badenum.