From 029c7ebe7f4f9ea37d715dbc2da36687d8657c2c Mon Sep 17 00:00:00 2001 From: Gaius Mulley Date: Wed, 19 Jul 2023 17:46:52 +0100 Subject: [PATCH] [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 --- gcc/m2/gm2-compiler/M2Quads.mod | 53 +++++++++++++---------- gcc/m2/gm2-compiler/M2SymInit.mod | 2 - gcc/testsuite/gm2/errors/fail/badabs.mod | 7 +++ gcc/testsuite/gm2/errors/fail/badenum.mod | 8 ++++ 4 files changed, 44 insertions(+), 26 deletions(-) create mode 100644 gcc/testsuite/gm2/errors/fail/badabs.mod create mode 100644 gcc/testsuite/gm2/errors/fail/badenum.mod diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 3e4863b3baf..51c2835d082 100644 --- 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 b7978e55ef2..81d1e6baf50 100644 --- 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 index 00000000000..a7d994a972c --- /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 index 00000000000..02b7eb2612c --- /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.