https://gcc.gnu.org/g:4bd2f59af4a78cdc80039cffa51c1d9ad91081a3
commit r14-9739-g4bd2f59af4a78cdc80039cffa51c1d9ad91081a3 Author: Gaius Mulley <gaiusm...@gmail.com> Date: Mon Apr 1 19:18:36 2024 +0100 PR modula2/114548 gm2 fails to identify variable in a const expression This patch introduces stricter checking within standard procedure functions which detect whether paramaters are variable when used in a const expression. gcc/m2/ChangeLog: PR modula2/114548 * gm2-compiler/M2Quads.mod (ConvertToAddress): Pass procedure, false parameters to BuildConvertFunction. (PushOne): Pass procedure, true parameters to BuildConvertFunction. Remove usused parameter internal. (BuildPseudoBy): Remove parameter to PushOne. (BuildIncProcedure): Ditto. (BuildDecProcedure): Ditto. (BuildFunctionCall): Add ConstExpr parameter to BuildPseudoFunctionCall. (BuildConstFunctionCall): Add procedure and true to BuildConvertFunction. (BuildPseudoFunctionCall): Add ConstExpr parameter. Pass ProcSym and ConstExpr to BuildLengthFunction, BuildConvertFunction, BuildOddFunction, BuildAbsFunction, BuildCapFunction, BuildValFunction, BuildChrFunction, BuildOrdFunction, BuildIntFunction, BuildTruncFunction, BuildFloatFunction, BuildAddAdrFunction, BuildSubAdrFunction, BuildDifAdrFunction, BuildCastFunction, BuildReFunction, BuildImFunction and BuildCmplxFunction. (BuildAddAdrFunction): Add ProcSym, ConstExpr parameters and check for constant parameters. (BuildSubAdrFunction): Ditto. (BuildDifAdrFunction): Ditto. (ConstExprError): Ditto. (BuildLengthFunction): Ditto. (BuildOddFunction): Ditto. (BuildAbsFunction): Ditto. (BuildCapFunction): Ditto. (BuildChrFunction): Ditto. (BuildOrdFunction): Ditto. (BuildIntFunction): Ditto. (BuildValFunction): Ditto. (BuildCastFunction): Ditto. (BuildConvertFunction): Ditto. (BuildTruncFunction): Ditto. (BuildFloatFunction): Ditto. (BuildReFunction): Ditto. (BuildImFunction): Ditto. (BuildCmplxFunction): Ditto. gcc/testsuite/ChangeLog: PR modula2/114548 * gm2/iso/const/fail/expression.mod: New test. * gm2/iso/const/fail/iso-const-fail.exp: New test. * gm2/iso/const/fail/testabs.mod: New test. * gm2/iso/const/fail/testaddadr.mod: New test. * gm2/iso/const/fail/testcap.mod: New test. * gm2/iso/const/fail/testcap2.mod: New test. * gm2/iso/const/fail/testchr.mod: New test. * gm2/iso/const/fail/testchr2.mod: New test. * gm2/iso/const/fail/testcmplx.mod: New test. * gm2/iso/const/fail/testfloat.mod: New test. * gm2/iso/const/fail/testim.mod: New test. * gm2/iso/const/fail/testint.mod: New test. * gm2/iso/const/fail/testlength.mod: New test. * gm2/iso/const/fail/testodd.mod: New test. * gm2/iso/const/fail/testord.mod: New test. * gm2/iso/const/fail/testre.mod: New test. * gm2/iso/const/fail/testtrunc.mod: New test. * gm2/iso/const/fail/testval.mod: New test. * gm2/iso/const/pass/constbool.mod: New test. * gm2/iso/const/pass/constbool2.mod: New test. * gm2/iso/const/pass/constbool3.mod: New test. Signed-off-by: Gaius Mulley <gaiusm...@gmail.com> Diff: --- gcc/m2/gm2-compiler/M2Quads.mod | 454 ++++++++++++++------- gcc/testsuite/gm2/iso/const/fail/expression.mod | 10 + .../gm2/iso/const/fail/iso-const-fail.exp | 36 ++ gcc/testsuite/gm2/iso/const/fail/testabs.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testaddadr.mod | 12 + gcc/testsuite/gm2/iso/const/fail/testcap.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testcap2.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testchr.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testchr2.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testcmplx.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testfloat.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testim.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testint.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testlength.mod | 11 + gcc/testsuite/gm2/iso/const/fail/testodd.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testord.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testre.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testtrunc.mod | 10 + gcc/testsuite/gm2/iso/const/fail/testval.mod | 10 + gcc/testsuite/gm2/iso/const/pass/constbool.mod | 14 + gcc/testsuite/gm2/iso/const/pass/constbool2.mod | 12 + gcc/testsuite/gm2/iso/const/pass/constbool3.mod | 12 + 22 files changed, 553 insertions(+), 148 deletions(-) diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 891a76b4660..f2dfc8390ac 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -3326,7 +3326,7 @@ BEGIN PushT (SkipType(type)) ; PushT (expr) ; PushT (2) ; (* Two parameters *) - BuildConvertFunction ; + BuildConvertFunction (Convert, FALSE) ; PopT (expr) END ; RETURN( expr ) @@ -4356,7 +4356,7 @@ END BuildElsif2 ; *) PROCEDURE PushOne (tok: CARDINAL; type: CARDINAL; - message: ARRAY OF CHAR; internal: BOOLEAN) ; + message: ARRAY OF CHAR) ; VAR const: CARDINAL ; BEGIN @@ -4378,7 +4378,7 @@ BEGIN PushT (type) ; PushTFtok (MakeConstLit (tok, MakeKey ('1'), ZType), ZType, tok) ; PushT (2) ; (* Two parameters *) - BuildConvertFunction + BuildConvertFunction (Convert, TRUE) END ELSE const := MakeConstLit (tok, MakeKey ('1'), type) ; @@ -4413,7 +4413,7 @@ BEGIN PushTtok (type, tok) ; PushTtok (MakeConstLit (tok, MakeKey ('0'), ZType), tok) ; PushT (2) ; (* Two parameters *) - BuildConvertFunction + BuildConvertFunction (Convert, TRUE) ELSE PushTFtok (MakeConstLit (tok, MakeKey ('0'), type), type, tok) END @@ -4456,7 +4456,7 @@ BEGIN type := ZType END ; PushOne (dotok, type, - 'the implied {%kFOR} loop increment will cause an overflow {%1ad}', TRUE) + 'the implied {%kFOR} loop increment will cause an overflow {%1ad}') END BuildPseudoBy ; @@ -7246,7 +7246,7 @@ BEGIN PushT (dtype) ; PushT (expr) ; PushT (2) ; (* Two parameters *) - BuildConvertFunction ; + BuildConvertFunction (Convert, FALSE) ; doBuildBinaryOp (FALSE, TRUE) ELSE IF tok=PlusTok @@ -7313,7 +7313,7 @@ BEGIN OperandSym := DereferenceLValue (OperandTok (1), OperandT (1)) ELSE PushOne (proctok, dtype, - 'the {%EkINC} will cause an overflow {%1ad}', FALSE) ; + 'the {%EkINC} will cause an overflow {%1ad}') ; PopT (OperandSym) END ; @@ -7386,7 +7386,7 @@ BEGIN OperandSym := DereferenceLValue (OperandTok (1), OperandT (1)) ELSE PushOne (proctok, dtype, - 'the {%EkDEC} will cause an overflow {%1ad}', FALSE) ; + 'the {%EkDEC} will cause an overflow {%1ad}') ; PopT (OperandSym) END ; @@ -7680,7 +7680,7 @@ BEGIN IF IsUnknown (ProcSym) THEN paramtok := OperandTtok (1) ; - combinedtok := MakeVirtualTok (functok, functok, paramtok) ; + combinedtok := MakeVirtual2Tok (functok, paramtok) ; MetaErrorT1 (functok, 'procedure function {%1Ea} is undefined', ProcSym) ; PopN (NoOfParam + 2) ; (* Fake return value to continue compiling. *) @@ -7693,7 +7693,7 @@ BEGIN IsPseudoBaseFunction (ProcSym) THEN ManipulatePseudoCallParameters ; - BuildPseudoFunctionCall + BuildPseudoFunctionCall (ConstExpr) ELSE BuildRealFunctionCall (functok, ConstExpr) END @@ -7767,7 +7767,7 @@ BEGIN PushTtok (ProcSym, functok) ; PushTtok (ConstExpression, paramtok) ; PushT (2) ; (* Two parameters. *) - BuildConvertFunction + BuildConvertFunction (Convert, TRUE) ELSE MetaErrorT0 (functok, '{%E}a constant type conversion can only have one argument') END @@ -7952,7 +7952,7 @@ END BuildRealFunctionCall ; *) -PROCEDURE BuildPseudoFunctionCall ; +PROCEDURE BuildPseudoFunctionCall (ConstExpr: BOOLEAN) ; VAR NoOfParam, ProcSym : CARDINAL ; @@ -7961,13 +7961,13 @@ BEGIN ProcSym := OperandT (NoOfParam+1) ; ProcSym := SkipConst (ProcSym) ; PushT (NoOfParam) ; - (* Compile time stack restored to entry state *) + (* Compile time stack restored to entry state. *) IF ProcSym = High THEN BuildHighFunction ELSIF ProcSym = LengthS THEN - BuildLengthFunction + BuildLengthFunction (ProcSym, ConstExpr) ELSIF ProcSym = Adr THEN BuildAdrFunction @@ -7982,34 +7982,34 @@ BEGIN BuildTBitSizeFunction ELSIF ProcSym = Convert THEN - BuildConvertFunction + BuildConvertFunction (ProcSym, ConstExpr) ELSIF ProcSym = Odd THEN - BuildOddFunction + BuildOddFunction (ProcSym, ConstExpr) ELSIF ProcSym = Abs THEN - BuildAbsFunction + BuildAbsFunction (ProcSym, ConstExpr) ELSIF ProcSym = Cap THEN - BuildCapFunction + BuildCapFunction (ProcSym, ConstExpr) ELSIF ProcSym = Val THEN - BuildValFunction + BuildValFunction (ProcSym, ConstExpr) ELSIF ProcSym = Chr THEN - BuildChrFunction + BuildChrFunction (ProcSym, ConstExpr) ELSIF IsOrd (ProcSym) THEN - BuildOrdFunction (ProcSym) + BuildOrdFunction (ProcSym, ConstExpr) ELSIF IsInt (ProcSym) THEN - BuildIntFunction (ProcSym) + BuildIntFunction (ProcSym, ConstExpr) ELSIF IsTrunc (ProcSym) THEN - BuildTruncFunction (ProcSym) + BuildTruncFunction (ProcSym, ConstExpr) ELSIF IsFloat (ProcSym) THEN - BuildFloatFunction (ProcSym) + BuildFloatFunction (ProcSym, ConstExpr) ELSIF ProcSym = Min THEN BuildMinFunction @@ -8018,16 +8018,16 @@ BEGIN BuildMaxFunction ELSIF ProcSym = AddAdr THEN - BuildAddAdrFunction + BuildAddAdrFunction (ProcSym, ConstExpr) ELSIF ProcSym = SubAdr THEN - BuildSubAdrFunction + BuildSubAdrFunction (ProcSym, ConstExpr) ELSIF ProcSym = DifAdr THEN - BuildDifAdrFunction + BuildDifAdrFunction (ProcSym, ConstExpr) ELSIF ProcSym = Cast THEN - BuildCastFunction + BuildCastFunction (ProcSym, ConstExpr) ELSIF ProcSym = Shift THEN BuildShiftFunction @@ -8039,13 +8039,13 @@ BEGIN BuildMakeAdrFunction ELSIF ProcSym = Re THEN - BuildReFunction + BuildReFunction (ProcSym, ConstExpr) ELSIF ProcSym = Im THEN - BuildImFunction + BuildImFunction (ProcSym, ConstExpr) ELSIF ProcSym = Cmplx THEN - BuildCmplxFunction + BuildCmplxFunction (ProcSym, ConstExpr) ELSE InternalError ('pseudo function not implemented yet') END @@ -8078,10 +8078,11 @@ END BuildPseudoFunctionCall ; |----------------| |------------| *) -PROCEDURE BuildAddAdrFunction ; +PROCEDURE BuildAddAdrFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ; VAR combinedtok, functok, + vartok, optok : CARDINAL ; opa, ReturnVar, @@ -8094,11 +8095,18 @@ BEGIN IF NoOfParam=2 THEN VarSym := OperandT (2) ; + vartok := OperandTok (2) ; OperandSym := OperandT (1) ; optok := OperandTok (1) ; - combinedtok := MakeVirtualTok (functok, functok, optok) ; + combinedtok := MakeVirtual2Tok (functok, optok) ; PopN (NoOfParam + 1) ; - IF IsVar (VarSym) + IF ConstExprError (ProcSym, VarSym, vartok, ConstExpr) OR + ConstExprError (ProcSym, OperandSym, optok, ConstExpr) + THEN + (* Fake return result. *) + PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address), + Address, combinedtok) + ELSIF IsVar (VarSym) THEN IF IsReallyPointer (VarSym) OR (GetSType (VarSym) = Address) THEN @@ -8119,9 +8127,10 @@ BEGIN PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address), Address, combinedtok) END ELSE - MetaErrorT0 (functok, '{%E}SYSTEM procedure ADDADR expects 2 parameters') ; - PopN (NoOfParam + 1) ; - PushTFtok (MakeConstLit (functok, MakeKey ('0'), Address), Address, functok) + MetaErrorT0 (functok, + '{%E}SYSTEM procedure {%EkADDADR} expects 2 parameters') ; + PopN (NoOfParam+1) ; + PushTFtok (MakeConstLit (functok, MakeKey('0'), Address), Address, functok) END END BuildAddAdrFunction ; @@ -8152,7 +8161,7 @@ END BuildAddAdrFunction ; |----------------| |------------| *) -PROCEDURE BuildSubAdrFunction ; +PROCEDURE BuildSubAdrFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ; VAR functok, combinedtok, @@ -8166,15 +8175,21 @@ VAR BEGIN PopT (NoOfParam) ; functok := OperandTtok (NoOfParam + 1) ; - OperandSym := OperandT (1) ; - optok := OperandTok (1) ; IF NoOfParam = 2 THEN + optok := OperandTok (1) ; + OperandSym := OperandT (1) ; VarSym := OperandT (2) ; vartok := OperandTok (2) ; combinedtok := MakeVirtualTok (functok, functok, optok) ; PopN (NoOfParam + 1) ; - IF IsVar (VarSym) + IF ConstExprError (ProcSym, VarSym, vartok, ConstExpr) OR + ConstExprError (ProcSym, OperandSym, optok, ConstExpr) + THEN + (* Fake return result. *) + PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address), + Address, combinedtok) + ELSIF IsVar (VarSym) THEN IF IsReallyPointer (VarSym) OR (GetSType (VarSym) = Address) THEN @@ -8197,11 +8212,10 @@ BEGIN PushTFtok (MakeConstLit (combinedtok, MakeKey ('0'), Address), Address, combinedtok) END ELSE - combinedtok := MakeVirtualTok (functok, functok, optok) ; MetaErrorT0 (functok, '{%E}SYSTEM procedure {%EkSUBADR} expects 2 parameters') ; PopN (NoOfParam+1) ; - PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Address), Address, combinedtok) + PushTFtok (MakeConstLit (functok, MakeKey('0'), Address), Address, functok) END END BuildSubAdrFunction ; @@ -8233,7 +8247,7 @@ END BuildSubAdrFunction ; |----------------| |------------| *) -PROCEDURE BuildDifAdrFunction ; +PROCEDURE BuildDifAdrFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ; VAR functok, optok, @@ -8247,15 +8261,26 @@ VAR BEGIN PopT (NoOfParam) ; functok := OperandTtok (NoOfParam + 1) ; - OperandSym := OperandT (1) ; - optok := OperandTok (1) ; + IF NoOfParam >= 1 + THEN + OperandSym := OperandT (1) ; + optok := OperandTok (1) + ELSE + optok := functok + END ; IF NoOfParam = 2 THEN VarSym := OperandT (2) ; vartok := OperandTok (2) ; combinedtok := MakeVirtualTok (functok, functok, optok) ; PopN (NoOfParam + 1) ; - IF IsVar (VarSym) + IF ConstExprError (ProcSym, VarSym, vartok, ConstExpr) OR + ConstExprError (ProcSym, OperandSym, optok, ConstExpr) + THEN + (* Fake return result. *) + PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Integer), + Integer, combinedtok) + ELSIF IsVar (VarSym) THEN IF IsReallyPointer (VarSym) OR (GetSType (VarSym) = Address) THEN @@ -8273,7 +8298,7 @@ BEGIN PushTtok (Integer, functok) ; PushTtok (TempVar, vartok) ; PushT (2) ; (* Two parameters *) - BuildConvertFunction + BuildConvertFunction (Convert, ConstExpr) ELSE MetaError1 ('the second parameter to {%EkDIFADR} {%1Ea} must be a variable of type ADDRESS or a {%EkPOINTER}, rather than a {%1Etsd}', OperandSym) ; @@ -8290,8 +8315,8 @@ BEGIN PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Integer), Integer, combinedtok) END ELSE - combinedtok := MakeVirtualTok (functok, functok, optok) ; - MetaErrorT0 (functok, '{%E}SYSTEM procedure {%EkDIFADR} expects 2 parameters') ; + combinedtok := MakeVirtual2Tok (functok, optok) ; + MetaErrorT0 (combinedtok, '{%E}SYSTEM procedure {%EkDIFADR} expects 2 parameters') ; PopN (NoOfParam+1) ; PushTFtok (MakeConstLit (combinedtok, MakeKey('0'), Integer), Integer, combinedtok) END @@ -8487,6 +8512,24 @@ BEGIN END GetQualidentImport ; +(* + ConstExprError - return TRUE if a constant expression is being built and Var is a variable. +*) + +PROCEDURE ConstExprError (Func, Var: CARDINAL; optok: CARDINAL; ConstExpr: BOOLEAN) : BOOLEAN ; +BEGIN + IF ConstExpr AND IsVar (Var) + THEN + MetaErrorT2 (optok, + 'the procedure function {%1Ea} is being called from within a constant expression and therefore the parameter {%2a} must be a constant, seen a {%2da}', + Func, Var) ; + RETURN TRUE + ELSE + RETURN FALSE + END +END ConstExprError ; + + (* DeferMakeLengthConst - creates a constant which contains the length of string, sym. *) @@ -8521,7 +8564,7 @@ END DeferMakeLengthConst ; *) -PROCEDURE BuildLengthFunction ; +PROCEDURE BuildLengthFunction (Function: CARDINAL; ConstExpr: BOOLEAN) ; VAR combinedtok, paramtok, @@ -8545,7 +8588,7 @@ BEGIN END ; IF NoOfParam >= 1 THEN - combinedtok := MakeVirtualTok (paramtok, functok, paramtok) ; + combinedtok := MakeVirtual2Tok (functok, paramtok) ; IF IsConst (Param) AND (GetSType (Param) = Char) THEN PopT (NoOfParam) ; @@ -8563,16 +8606,22 @@ BEGIN IF (ProcSym # NulSym) AND IsProcedure (ProcSym) THEN PopT (NoOfParam) ; - IF IsConst (OperandT (1)) + IF IsConst (Param) THEN - (* we can fold this in M2GenGCC. *) + (* This can be folded in M2GenGCC. *) ReturnVar := MakeTemporary (combinedtok, ImmediateValue) ; PutVar (ReturnVar, Cardinal) ; - GenQuad (StandardFunctionOp, ReturnVar, ProcSym, OperandT (1)) ; + GenQuad (StandardFunctionOp, ReturnVar, ProcSym, Param) ; PopN (NoOfParam + 1) ; PushTtok (ReturnVar, combinedtok) + ELSIF ConstExprError (Function, Param, paramtok, ConstExpr) + THEN + (* Fake a result as we have detected and reported an error. *) + PopN (NoOfParam + 1) ; + ReturnVar := MakeConstLit (combinedtok, MakeKey ('1'), Cardinal) ; + PushTtok (ReturnVar, combinedtok) ELSE - (* no we must resolve this at runtime or in the GCC optimizer. *) + (* We must resolve this at runtime or in the GCC optimizer. *) PopTF (Param, Type); PopN (NoOfParam) ; PushTtok (ProcSym, functok) ; @@ -8627,7 +8676,7 @@ END BuildLengthFunction ; |----------------| *) -PROCEDURE BuildOddFunction ; +PROCEDURE BuildOddFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ; VAR combinedtok, optok, @@ -8642,7 +8691,11 @@ BEGIN Var := OperandT (1) ; optok := OperandTok (1) ; combinedtok := MakeVirtualTok (functok, functok, optok) ; - IF IsVar(Var) OR IsConst(Var) + IF ConstExprError (ProcSym, Var, optok, ConstExpr) + THEN + (* Nothing to do. *) + PushTtok (False, combinedtok) + ELSIF IsVar(Var) OR IsConst(Var) THEN PopN (NoOfParam + 1) ; (* @@ -8726,13 +8779,12 @@ END BuildOddFunction ; |----------------| *) -PROCEDURE BuildAbsFunction ; +PROCEDURE BuildAbsFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ; VAR vartok, functok, combinedtok: CARDINAL ; NoOfParam, - ProcSym, Res, Var : CARDINAL ; BEGIN PopT (NoOfParam) ; @@ -8741,12 +8793,16 @@ BEGIN THEN Var := OperandT (1) ; vartok := OperandTok (1) ; + PopN (NoOfParam + 1) ; combinedtok := MakeVirtualTok (functok, functok, vartok) ; - IF IsVar(Var) OR IsConst(Var) + IF ConstExprError (ProcSym, Var, vartok, ConstExpr) + THEN + (* Create fake result. *) + Res := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; + PutVar (Res, GetSType (Var)) ; + PushTFtok (Res, GetSType (Var), combinedtok) + ELSIF IsVar(Var) OR IsConst(Var) THEN - ProcSym := OperandT (NoOfParam + 1) ; - PopN (NoOfParam + 1) ; - Res := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; PutVar (Res, GetSType (Var)) ; @@ -8787,13 +8843,12 @@ END BuildAbsFunction ; |----------------| |-------------| *) -PROCEDURE BuildCapFunction ; +PROCEDURE BuildCapFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ; VAR optok, functok, combinedtok: CARDINAL ; NoOfParam, - ProcSym, Res, Var : CARDINAL ; BEGIN PopT (NoOfParam) ; @@ -8802,12 +8857,17 @@ BEGIN THEN Var := OperandT (1) ; optok := OperandTok (1) ; - IF IsVar (Var) OR IsConst (Var) + PopN (NoOfParam + 1) ; + IF ConstExprError (ProcSym, Var, optok, ConstExpr) THEN - ProcSym := OperandT (NoOfParam + 1) ; - PopN (NoOfParam + 1) ; - - combinedtok := MakeVirtualTok (functok, functok, optok) ; + (* Create fake result. *) + combinedtok := MakeVirtual2Tok (functok, optok) ; + Res := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; + PutVar (Res, Char) ; + PushTFtok (Res, Char, combinedtok) + ELSIF IsVar (Var) OR IsConst (Var) + THEN + combinedtok := MakeVirtual2Tok (functok, optok) ; Res := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; PutVar (Res, Char) ; GenQuadO (combinedtok, StandardFunctionOp, Res, ProcSym, Var, FALSE) ; @@ -8858,10 +8918,12 @@ END BuildCapFunction ; |----------------| *) -PROCEDURE BuildChrFunction ; +PROCEDURE BuildChrFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ; VAR functok, + combinedtok, optok : CARDINAL ; + ReturnVar, NoOfParam, Var : CARDINAL ; BEGIN @@ -8871,9 +8933,16 @@ BEGIN THEN Var := OperandT (1) ; optok := OperandTok (1) ; - IF IsVar (Var) OR IsConst (Var) + PopN (NoOfParam + 1) ; + IF ConstExprError (ProcSym, Var, optok, ConstExpr) + THEN + (* Generate fake result. *) + combinedtok := MakeVirtual2Tok (functok, optok) ; + ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; + PutVar (ReturnVar, Char) ; + PushTFtok (ReturnVar, Char, combinedtok) + ELSIF IsVar (Var) OR IsConst (Var) THEN - PopN (NoOfParam + 1) ; (* Build macro: CONVERT( CHAR, Var ) *) @@ -8881,7 +8950,7 @@ BEGIN PushTtok (Char, functok) ; PushTtok (Var, optok) ; PushT (2) ; (* Two parameters *) - BuildConvertFunction + BuildConvertFunction (Convert, ConstExpr) ELSE MetaErrorT1 (optok, 'the parameter to {%AkCHR} must be a variable or constant, seen {%1ad}', @@ -8928,12 +8997,14 @@ END BuildChrFunction ; |----------------| *) -PROCEDURE BuildOrdFunction (Sym: CARDINAL) ; +PROCEDURE BuildOrdFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ; VAR + combinedtok, functok, - optok : CARDINAL ; + optok : CARDINAL ; + ReturnVar, NoOfParam, - Type, Var: CARDINAL ; + Type, Var : CARDINAL ; BEGIN PopT (NoOfParam) ; functok := OperandTok (NoOfParam + 1) ; @@ -8941,10 +9012,17 @@ BEGIN THEN Var := OperandT (1) ; optok := OperandTok (1) ; - IF IsVar (Var) OR IsConst (Var) + PopN (NoOfParam + 1) ; + IF ConstExprError (Sym, Var, optok, ConstExpr) + THEN + (* Generate fake result. *) + combinedtok := MakeVirtual2Tok (functok, optok) ; + ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; + PutVar (ReturnVar, Cardinal) ; + PushTFtok (ReturnVar, Cardinal, combinedtok) + ELSIF IsVar (Var) OR IsConst (Var) THEN Type := GetSType (Sym) ; - PopN (NoOfParam + 1) ; (* Build macro: CONVERT( CARDINAL, Var ) *) @@ -8952,7 +9030,7 @@ BEGIN PushTtok (Type, optok) ; PushTtok (Var, optok) ; PushT (2) ; (* Two parameters *) - BuildConvertFunction + BuildConvertFunction (Convert, ConstExpr) ELSE MetaErrorT2 (optok, 'the parameter to {%1Aa} must be a variable or constant, seen {%2ad}', @@ -8999,11 +9077,12 @@ END BuildOrdFunction ; |----------------| *) -PROCEDURE BuildIntFunction (Sym: CARDINAL) ; +PROCEDURE BuildIntFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ; VAR combinedtok, functok, optok : CARDINAL ; + ReturnVar, NoOfParam, Type, Var : CARDINAL ; BEGIN @@ -9013,16 +9092,23 @@ BEGIN THEN Var := OperandT (1) ; optok := OperandTok (1) ; - IF IsVar (Var) OR IsConst (Var) + PopN (NoOfParam + 1) ; + IF ConstExprError (Sym, Var, optok, ConstExpr) + THEN + (* Generate fake result. *) + combinedtok := MakeVirtual2Tok (functok, optok) ; + ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; + PutVar (ReturnVar, Integer) ; + PushTFtok (ReturnVar, Integer, combinedtok) + ELSIF IsVar (Var) OR IsConst (Var) THEN Type := GetSType (Sym) ; (* return type of function *) - PopN (NoOfParam + 1) ; (* Build macro: CONVERT( CARDINAL, Var ). *) PushTFtok (Convert, NulSym, functok) ; PushTtok (Type, functok) ; PushTtok (Var, optok) ; PushT (2) ; (* Two parameters *) - BuildConvertFunction + BuildConvertFunction (Convert, ConstExpr) ELSE combinedtok := MakeVirtualTok (functok, optok, optok) ; MetaErrorT2 (optok, @@ -9305,15 +9391,16 @@ END BuildRotateFunction ; |----------------| *) -PROCEDURE BuildValFunction ; +PROCEDURE BuildValFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ; VAR - functok : CARDINAL ; + combinedtok, + functok : CARDINAL ; + ReturnVar, NoOfParam, - ProcSym, - Exp, Type: CARDINAL ; + Exp, Type : CARDINAL ; tok, r, typetok, - exptok : CARDINAL ; + exptok : CARDINAL ; BEGIN PopT (NoOfParam) ; functok := OperandTok (NoOfParam + 1) ; @@ -9330,6 +9417,13 @@ BEGIN 'undeclared type found in builtin procedure function {%AkVAL} {%1ad}', Type) (* non recoverable error. *) + ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr) + THEN + (* Generate fake result. *) + combinedtok := MakeVirtualTok (functok, functok, exptok) ; + ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Exp))) ; + PutVar (ReturnVar, Type) ; + PushTFtok (ReturnVar, Type, combinedtok) ELSIF (IsSet (Type) OR IsEnumeration (Type) OR IsSubrange (Type) OR IsType (Type) OR IsPointer (Type) OR IsProcType (Type)) AND (IsVar (Exp) OR IsConst (Exp) OR IsProcedure (Exp)) @@ -9341,7 +9435,7 @@ BEGIN PushTtok (Type, typetok) ; PushTtok (Exp, exptok) ; PushT (2) ; (* Two parameters *) - BuildConvertFunction + BuildConvertFunction (Convert, ConstExpr) ELSE (* not sensible to try and recover when we dont know the return type. *) MetaErrorT0 (functok, @@ -9390,16 +9484,15 @@ END BuildValFunction ; |----------------| *) -PROCEDURE BuildCastFunction ; +PROCEDURE BuildCastFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ; VAR combinedtok, + exptok, typetok, - functok, - vartok : CARDINAL ; - n : Name ; + functok : CARDINAL ; ReturnVar, NoOfParam, - Var, Type : CARDINAL ; + Exp, Type : CARDINAL ; BEGIN PopT (NoOfParam) ; functok := OperandTok (NoOfParam + 1) ; @@ -9407,32 +9500,40 @@ BEGIN THEN Type := OperandT (2) ; typetok := OperandTok (2) ; - Var := OperandT (1) ; - vartok := OperandTok (1) ; + Exp := OperandT (1) ; + exptok := OperandTok (1) ; IF IsUnknown (Type) THEN - n := GetSymName (Type) ; - WriteFormat1 ('undeclared type found in CAST (%a)', n) + (* we cannot recover if we dont have a type. *) + MetaErrorT1 (typetok, 'undeclared type {%1Aad} found in {%kCAST}', Type) + (* non recoverable error. *) + ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr) + THEN + (* Generate fake result. *) + combinedtok := MakeVirtualTok (functok, functok, exptok) ; + ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Exp))) ; + PutVar (ReturnVar, Type) ; + PushTFtok (ReturnVar, Type, combinedtok) ELSIF IsSet (Type) OR IsEnumeration (Type) OR IsSubrange (Type) OR IsType (Type) OR IsPointer (Type) OR IsArray (Type) OR IsProcType (Type) THEN - IF IsConst (Var) + IF IsConst (Exp) THEN PopN (NoOfParam+1) ; (* Build macro: Type( Var ) *) PushTFtok (Type, NulSym, typetok) ; - PushTtok (Var, vartok) ; + PushTtok (Exp, exptok) ; PushT (1) ; (* one parameter *) BuildTypeCoercion - ELSIF IsVar (Var) OR IsProcedure (Var) + ELSIF IsVar (Exp) OR IsProcedure (Exp) THEN PopN (NoOfParam + 1) ; - combinedtok := MakeVirtualTok (functok, functok, vartok) ; + combinedtok := MakeVirtual2Tok (functok, exptok) ; ReturnVar := MakeTemporary (combinedtok, RightValue) ; PutVar (ReturnVar, Type) ; - GenQuadO (combinedtok, CastOp, ReturnVar, Type, Var, FALSE) ; + GenQuadO (combinedtok, CastOp, ReturnVar, Type, Exp, FALSE) ; PushTFtok (ReturnVar, Type, combinedtok) ELSE (* not sensible to try and recover when we dont know the return type. *) @@ -9489,7 +9590,7 @@ END BuildCastFunction ; with a type Param1. *) -PROCEDURE BuildConvertFunction ; +PROCEDURE BuildConvertFunction (ProcSym: CARDINAL; ConstExpr: BOOLEAN) ; VAR combinedtok, functok, @@ -9497,7 +9598,6 @@ VAR exptok : CARDINAL ; t, r, Exp, Type, - ProcSym, NoOfParam, ReturnVar : CARDINAL ; BEGIN @@ -9519,6 +9619,13 @@ BEGIN (* we cannot recover if we dont have a type. *) MetaErrorT1 (typetok, 'unknown {%1Ad} {%1ad} found in {%kCONVERT}', Exp) (* non recoverable error. *) + ELSIF ConstExprError (ProcSym, Exp, exptok, ConstExpr) + THEN + (* Generate fake result. *) + combinedtok := MakeVirtualTok (functok, functok, exptok) ; + ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Exp))) ; + PutVar (ReturnVar, Type) ; + PushTFtok (ReturnVar, Type, combinedtok) ELSIF (IsSet (Type) OR IsEnumeration (Type) OR IsSubrange (Type) OR IsType (Type) OR IsPointer (Type) OR IsProcType (Type) OR IsRecord (Type)) AND (IsVar (Exp) OR IsConst (Exp) OR IsProcedure (Exp)) @@ -9807,14 +9914,16 @@ END BuildMaxFunction ; |----------------| *) -PROCEDURE BuildTruncFunction (Sym: CARDINAL) ; +PROCEDURE BuildTruncFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ; VAR + combinedtok, vartok, - functok : CARDINAL ; - NoOfParam: CARDINAL ; + functok : CARDINAL ; + NoOfParam : CARDINAL ; + ReturnVar, ProcSym, Type, - Var : CARDINAL ; + Var : CARDINAL ; BEGIN PopT (NoOfParam) ; Assert (IsTrunc (OperandT (NoOfParam+1))) ; @@ -9828,7 +9937,14 @@ BEGIN vartok := OperandTtok (1) ; Type := GetSType (Sym) ; PopN (NoOfParam + 1) ; (* destroy arguments to this function *) - IF IsVar (Var) OR IsConst (Var) + IF ConstExprError (Sym, Var, vartok, ConstExpr) + THEN + (* Generate fake result. *) + combinedtok := MakeVirtual2Tok (functok, vartok) ; + ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; + PutVar (ReturnVar, Type) ; + PushTFtok (ReturnVar, Type, combinedtok) + ELSIF IsVar (Var) OR IsConst (Var) THEN IF IsRealType (GetSType (Var)) THEN @@ -9837,7 +9953,7 @@ BEGIN PushTtok (Type, functok) ; PushTtok (Var, vartok) ; PushT (2) ; (* two parameters *) - BuildConvertFunction + BuildConvertFunction (Convert, ConstExpr) ELSE MetaErrorT1 (functok, 'argument to {%1Ead} must be a float point type', Sym) ; @@ -9894,14 +10010,16 @@ END BuildTruncFunction ; |----------------| *) -PROCEDURE BuildFloatFunction (Sym: CARDINAL) ; +PROCEDURE BuildFloatFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ; VAR + combinedtok, vartok, - functok : CARDINAL ; - NoOfParam: CARDINAL ; + functok : CARDINAL ; + NoOfParam : CARDINAL ; + ReturnVar, Type, Var, - ProcSym : CARDINAL ; + ProcSym : CARDINAL ; BEGIN PopT (NoOfParam) ; functok := OperandTtok (NoOfParam + 1) ; @@ -9913,15 +10031,22 @@ BEGIN THEN Var := OperandT (1) ; vartok := OperandTtok (1) ; - IF IsVar (Var) OR IsConst (Var) + PopN (NoOfParam + 1) ; (* destroy arguments to this function. *) + IF ConstExprError (Sym, Var, vartok, ConstExpr) + THEN + (* Generate fake result. *) + combinedtok := MakeVirtual2Tok (functok, vartok) ; + ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; + PutVar (ReturnVar, Type) ; + PushTFtok (ReturnVar, Type, combinedtok) + ELSIF IsVar (Var) OR IsConst (Var) THEN - PopN (NoOfParam + 1) ; (* destroy arguments to this function. *) (* build macro: CONVERT (REAL, Var). *) PushTFtok (ProcSym, NulSym, functok) ; PushTtok (Type, functok) ; PushTtok (Var, vartok) ; PushT(2) ; (* two parameters. *) - BuildConvertFunction + BuildConvertFunction (ProcSym, ConstExpr) ELSE MetaErrorT1 (vartok, 'argument to {%1Ead} must be a variable or constant', ProcSym) ; @@ -9931,6 +10056,7 @@ BEGIN InternalError ('CONVERT procedure not found for FLOAT substitution') END ELSE + PopN (NoOfParam + 1) ; (* destroy arguments to this function. *) MetaErrorT1 (functok, 'the builtin procedure function {%1Ead} only has one parameter', Sym) ; @@ -9965,7 +10091,7 @@ END BuildFloatFunction ; |----------------| *) -PROCEDURE BuildReFunction ; +PROCEDURE BuildReFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ; VAR func, combinedtok, @@ -9973,6 +10099,7 @@ VAR functok : CARDINAL ; NoOfParam : CARDINAL ; ReturnVar, + Type, Var : CARDINAL ; BEGIN PopT (NoOfParam) ; @@ -9983,15 +10110,22 @@ BEGIN Var := OperandT (1) ; vartok := OperandTok (1) ; combinedtok := MakeVirtualTok (functok, functok, vartok) ; - IF IsVar(Var) OR IsConst(Var) + Type := ComplexToScalar (GetDType (Var)) ; + PopN (NoOfParam+1) ; (* destroy arguments to this function *) + IF ConstExprError (Sym, Var, vartok, ConstExpr) THEN + (* Generate fake result. *) + combinedtok := MakeVirtual2Tok (functok, vartok) ; ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; - PutVar (ReturnVar, ComplexToScalar (GetDType (Var))) ; + PutVar (ReturnVar, Type) ; + PushTFtok (ReturnVar, Type, combinedtok) + ELSIF IsVar(Var) OR IsConst(Var) + THEN + ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; + PutVar (ReturnVar, Type) ; GenQuadO (combinedtok, StandardFunctionOp, ReturnVar, Re, Var, FALSE) ; - PopN (NoOfParam+1) ; (* destroy arguments to this function *) - PushTFtok (ReturnVar, GetSType (ReturnVar), combinedtok) + PushTFtok (ReturnVar, Type, combinedtok) ELSE - PopN (NoOfParam+1) ; (* destroy arguments to this function *) PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ; MetaErrorT2 (vartok, 'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}', @@ -10033,7 +10167,7 @@ END BuildReFunction ; |----------------| *) -PROCEDURE BuildImFunction ; +PROCEDURE BuildImFunction (Sym: CARDINAL; ConstExpr: BOOLEAN) ; VAR func, combinedtok, @@ -10041,6 +10175,7 @@ VAR functok : CARDINAL ; NoOfParam : CARDINAL ; ReturnVar, + Type, Var : CARDINAL ; BEGIN PopT (NoOfParam) ; @@ -10050,16 +10185,23 @@ BEGIN THEN Var := OperandT (1) ; vartok := OperandTok (1) ; + Type := ComplexToScalar (GetDType (Var)) ; combinedtok := MakeVirtualTok (functok, functok, vartok) ; - IF IsVar(Var) OR IsConst(Var) + PopN (NoOfParam+1) ; (* destroy arguments to this function *) + IF ConstExprError (Sym, Var, vartok, ConstExpr) + THEN + (* Generate fake result. *) + combinedtok := MakeVirtual2Tok (functok, vartok) ; + ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; + PutVar (ReturnVar, Type) ; + PushTFtok (ReturnVar, Type, combinedtok) + ELSIF IsVar(Var) OR IsConst(Var) THEN ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (Var))) ; PutVar (ReturnVar, ComplexToScalar (GetDType (Var))) ; GenQuadO (combinedtok, StandardFunctionOp, ReturnVar, Im, Var, FALSE) ; - PopN (NoOfParam+1) ; (* destroy arguments to this function *) PushTFtok (ReturnVar, GetSType (ReturnVar), combinedtok) ELSE - PopN (NoOfParam+1) ; (* destroy arguments to this function *) PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), RType), RType, combinedtok) ; MetaErrorT2 (vartok, 'the parameter to the builtin procedure function {%1Ead} must be a constant or a variable, seen {%2ad}', @@ -10101,34 +10243,53 @@ END BuildImFunction ; |----------------| *) -PROCEDURE BuildCmplxFunction ; +PROCEDURE BuildCmplxFunction (func: CARDINAL; ConstExpr: BOOLEAN) ; VAR + failure : BOOLEAN ; functok, - endtok, + rtok, ltok, combinedtok: CARDINAL ; NoOfParam : CARDINAL ; - func, + type, ReturnVar, l, r : CARDINAL ; BEGIN PopT (NoOfParam) ; functok := OperandTtok (NoOfParam + 1) ; - func := OperandT (NoOfParam + 1) ; IF NoOfParam = 2 THEN l := OperandT (2) ; + ltok := OperandTtok (2) ; r := OperandT (1) ; - endtok := OperandTok (1) ; - combinedtok := MakeVirtualTok (functok, functok, endtok) ; - IF (IsVar(l) OR IsConst(l)) AND - (IsVar(r) OR IsConst(r)) + rtok := OperandTtok (1) ; + combinedtok := MakeVirtual2Tok (functok, rtok) ; + PopN (NoOfParam+1) ; (* Destroy arguments to this function. *) + type := GetCmplxReturnType (GetDType (l), GetDType (r)) ; + ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (l) AND IsConst (r))) ; + PutVar (ReturnVar, type) ; + failure := FALSE ; + IF ConstExprError (func, l, ltok, ConstExpr) + THEN + (* ConstExprError has generated an error message we will fall through + and check the right operand. *) + failure := TRUE + END ; + IF ConstExprError (func, r, rtok, ConstExpr) + THEN + (* Right operand is in error as a variable. *) + failure := TRUE + END ; + IF failure + THEN + (* Generate a fake result if either operand was a variable (and we + are in a const expression). *) + PushTFtok (ReturnVar, type, combinedtok) + ELSIF (IsVar (l) OR IsConst (l)) AND + (IsVar (r) OR IsConst (r)) THEN CheckExpressionCompatible (combinedtok, GetSType(l), GetSType(r)) ; - ReturnVar := MakeTemporary (combinedtok, AreConstant (IsConst (l) AND IsConst (r))) ; - PutVar (ReturnVar, GetCmplxReturnType (GetDType (l), GetDType (r))) ; GenQuadO (combinedtok, StandardFunctionOp, ReturnVar, Cmplx, Make2Tuple (l, r), TRUE) ; - PopN (NoOfParam+1) ; (* destroy arguments to this function *) - PushTFtok (ReturnVar, GetSType (ReturnVar), combinedtok) + PushTFtok (ReturnVar, type, combinedtok) ELSE IF IsVar (l) OR IsConst (l) THEN @@ -10140,7 +10301,6 @@ BEGIN 'the builtin procedure {%1Ead} requires two parameters, both must be variables or constants but the first parameter is {%2d}', func, l) END ; - PopN (NoOfParam+1) ; (* destroy arguments to this function *) PushTFtok (MakeConstLit (combinedtok, MakeKey ('1.0'), CType), CType, combinedtok) END ELSE @@ -11374,7 +11534,7 @@ BEGIN PushT (Address) ; PushTtok (sym, tokpos) ; PushT(2) ; (* Two parameters *) - BuildConvertFunction ; + BuildConvertFunction (Convert, FALSE) ; PopT (adr) ; RETURN adr END @@ -11487,7 +11647,7 @@ BEGIN PushT (Cardinal) ; PushTtok (idx, indexTok) ; PushT(2) ; (* Two parameters *) - BuildConvertFunction ; + BuildConvertFunction (Convert, FALSE) ; PopT (idx) END ; PutVar (tj, Cardinal) ; @@ -11941,7 +12101,6 @@ VAR typepos, Type : CARDINAL ; NulSet : CARDINAL ; - tok : CARDINAL ; BEGIN PopTtok (Type, typepos) ; (* type of set we are building *) IF (Type = NulSym) AND Pim @@ -12244,7 +12403,6 @@ END BuildConstructorStart ; PROCEDURE BuildConstructorEnd (startpos, cbratokpos: CARDINAL) ; VAR - typetok, value, valtok: CARDINAL ; BEGIN IF DebugTokPos @@ -12510,7 +12668,7 @@ BEGIN PushT(type) ; PushT(sym) ; PushT(2) ; (* Two parameters *) - BuildConvertFunction ; + BuildConvertFunction (Convert, FALSE) ; PopT(sym) END ; RETURN( sym ) diff --git a/gcc/testsuite/gm2/iso/const/fail/expression.mod b/gcc/testsuite/gm2/iso/const/fail/expression.mod new file mode 100644 index 00000000000..121d7f4ff08 --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/expression.mod @@ -0,0 +1,10 @@ +MODULE expression ; + +CONST + foo = ABS (i) + 2 + ABS (-100) ; + +VAR + i: INTEGER ; +BEGIN + +END expression. diff --git a/gcc/testsuite/gm2/iso/const/fail/iso-const-fail.exp b/gcc/testsuite/gm2/iso/const/fail/iso-const-fail.exp new file mode 100644 index 00000000000..59b6b29a5dd --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/iso-const-fail.exp @@ -0,0 +1,36 @@ +# Copyright (C) 2024 Free Software Foundation, Inc. + +# This program 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 of the License, or +# (at your option) any later version. +# +# This program 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 GCC; see the file COPYING3. If not see +# <http://www.gnu.org/licenses/>. + +# This file was written by Gaius Mulley (gaius.mul...@southwales.ac.uk) +# for GNU Modula-2. + +if $tracelevel then { + strace $tracelevel +} + +# load support procs +load_lib gm2-torture.exp + +gm2_init_iso "${srcdir}/gm2/iso/const/fail" + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] { + # If we're only testing specific files and this isn't one of them, skip it. + if ![runtest_file_p $runtests $testcase] then { + continue + } + + gm2-torture-fail $testcase +} diff --git a/gcc/testsuite/gm2/iso/const/fail/testabs.mod b/gcc/testsuite/gm2/iso/const/fail/testabs.mod new file mode 100644 index 00000000000..561688b403f --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testabs.mod @@ -0,0 +1,10 @@ +MODULE testabs ; + +CONST + foo = ABS (i + 1) ; + +VAR + i: INTEGER ; +BEGIN + +END testabs. diff --git a/gcc/testsuite/gm2/iso/const/fail/testaddadr.mod b/gcc/testsuite/gm2/iso/const/fail/testaddadr.mod new file mode 100644 index 00000000000..a9ebe8ad49e --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testaddadr.mod @@ -0,0 +1,12 @@ +MODULE testaddadr ; + +IMPORT SYSTEM ; + +CONST + foo = SYSTEM.ADDADR (ADR (a) + ADR (b)) ; + +VAR + a, b: CARDINAL ; +BEGIN + +END testaddadr. diff --git a/gcc/testsuite/gm2/iso/const/fail/testcap.mod b/gcc/testsuite/gm2/iso/const/fail/testcap.mod new file mode 100644 index 00000000000..e6d983d7471 --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testcap.mod @@ -0,0 +1,10 @@ +MODULE testcap ; + +CONST + foo = CAP (ch) ; + +VAR + ch: CHAR ; +BEGIN + +END testcap. diff --git a/gcc/testsuite/gm2/iso/const/fail/testcap2.mod b/gcc/testsuite/gm2/iso/const/fail/testcap2.mod new file mode 100644 index 00000000000..239472b62c2 --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testcap2.mod @@ -0,0 +1,10 @@ +MODULE testcap2 ; + +CONST + foo = CAP (ch + '8' - '1') ; + +VAR + ch: CHAR ; +BEGIN + +END testcap2. diff --git a/gcc/testsuite/gm2/iso/const/fail/testchr.mod b/gcc/testsuite/gm2/iso/const/fail/testchr.mod new file mode 100644 index 00000000000..cf3b5b85b4c --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testchr.mod @@ -0,0 +1,10 @@ +MODULE testchr ; + +CONST + foo = ORD (CHR (c)) ; + +VAR + c: CARDINAL ; +BEGIN + +END testchr. diff --git a/gcc/testsuite/gm2/iso/const/fail/testchr2.mod b/gcc/testsuite/gm2/iso/const/fail/testchr2.mod new file mode 100644 index 00000000000..73e2d230d1b --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testchr2.mod @@ -0,0 +1,10 @@ +MODULE testchr2 ; + +CONST + foo = CHR (c) ; + +VAR + c: CARDINAL ; +BEGIN + +END testchr2. diff --git a/gcc/testsuite/gm2/iso/const/fail/testcmplx.mod b/gcc/testsuite/gm2/iso/const/fail/testcmplx.mod new file mode 100644 index 00000000000..e9e22c0485e --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testcmplx.mod @@ -0,0 +1,10 @@ +MODULE testcmplx ; + +CONST + foo = CMPLX (r, i) ; + +VAR + r, i: REAL ; +BEGIN + +END testcmplx. diff --git a/gcc/testsuite/gm2/iso/const/fail/testfloat.mod b/gcc/testsuite/gm2/iso/const/fail/testfloat.mod new file mode 100644 index 00000000000..371e7fbc38c --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testfloat.mod @@ -0,0 +1,10 @@ +MODULE testfloat ; + +CONST + foo = FLOAT (c) ; + +VAR + c: CARDINAL ; +BEGIN + +END testfloat. diff --git a/gcc/testsuite/gm2/iso/const/fail/testim.mod b/gcc/testsuite/gm2/iso/const/fail/testim.mod new file mode 100644 index 00000000000..02cc2e43c3e --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testim.mod @@ -0,0 +1,10 @@ +MODULE testim ; + +CONST + foo = IM (cmplx) ; + +VAR + cmplx: COMPLEX ; +BEGIN + +END testim. diff --git a/gcc/testsuite/gm2/iso/const/fail/testint.mod b/gcc/testsuite/gm2/iso/const/fail/testint.mod new file mode 100644 index 00000000000..d241a13d3b8 --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testint.mod @@ -0,0 +1,10 @@ +MODULE testint ; + +CONST + foo = INT (r) ; + +VAR + r: REAL ; +BEGIN + +END testint. diff --git a/gcc/testsuite/gm2/iso/const/fail/testlength.mod b/gcc/testsuite/gm2/iso/const/fail/testlength.mod new file mode 100644 index 00000000000..c3f126b0079 --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testlength.mod @@ -0,0 +1,11 @@ +MODULE testlength ; + +PROCEDURE bar (a: ARRAY OF CHAR) ; +CONST + foo = LENGTH (a) ; +BEGIN +END bar ; + +BEGIN + bar ("hello") +END testlength. diff --git a/gcc/testsuite/gm2/iso/const/fail/testodd.mod b/gcc/testsuite/gm2/iso/const/fail/testodd.mod new file mode 100644 index 00000000000..d293e0cb372 --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testodd.mod @@ -0,0 +1,10 @@ +MODULE testodd ; + +CONST + foo = ODD (x) ; + +VAR + x: CARDINAL ; +BEGIN + +END testodd. diff --git a/gcc/testsuite/gm2/iso/const/fail/testord.mod b/gcc/testsuite/gm2/iso/const/fail/testord.mod new file mode 100644 index 00000000000..d862da1d652 --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testord.mod @@ -0,0 +1,10 @@ +MODULE testord ; + +CONST + foo = ORD (ch) ; + +VAR + ch: CHAR ; +BEGIN + +END testord. diff --git a/gcc/testsuite/gm2/iso/const/fail/testre.mod b/gcc/testsuite/gm2/iso/const/fail/testre.mod new file mode 100644 index 00000000000..60ecde5e6ae --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testre.mod @@ -0,0 +1,10 @@ +MODULE testre ; + +CONST + foo = RE (cmplx) ; + +VAR + cmplx: COMPLEX ; +BEGIN + +END testre. diff --git a/gcc/testsuite/gm2/iso/const/fail/testtrunc.mod b/gcc/testsuite/gm2/iso/const/fail/testtrunc.mod new file mode 100644 index 00000000000..6dcde30d83e --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testtrunc.mod @@ -0,0 +1,10 @@ +MODULE testtrunc ; + +CONST + foo = TRUNC (r) ; + +VAR + r: REAL ; +BEGIN + +END testtrunc. diff --git a/gcc/testsuite/gm2/iso/const/fail/testval.mod b/gcc/testsuite/gm2/iso/const/fail/testval.mod new file mode 100644 index 00000000000..438955c57f1 --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/fail/testval.mod @@ -0,0 +1,10 @@ +MODULE testval ; + +CONST + foo = VAL (INTEGER, c) ; + +VAR + c: CARDINAL ; +BEGIN + +END testval. diff --git a/gcc/testsuite/gm2/iso/const/pass/constbool.mod b/gcc/testsuite/gm2/iso/const/pass/constbool.mod new file mode 100644 index 00000000000..1be96cceaee --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/pass/constbool.mod @@ -0,0 +1,14 @@ +MODULE constbool ; + + +CONST + AddressableBits = 32 ; + MaxBits = 32 ; + + BitsInUse = + ORD(AddressableBits > MaxBits) * MaxBits + + ORD(AddressableBits <= MaxBits) * AddressableBits; + +BEGIN + +END constbool. diff --git a/gcc/testsuite/gm2/iso/const/pass/constbool2.mod b/gcc/testsuite/gm2/iso/const/pass/constbool2.mod new file mode 100644 index 00000000000..f8e294b5867 --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/pass/constbool2.mod @@ -0,0 +1,12 @@ +MODULE constbool2 ; + + +CONST + AddressableBits = 32 ; + MaxBits = 32 ; + + BitsInUse = ORD(AddressableBits > MaxBits) * MaxBits + ORD(AddressableBits <= MaxBits) * AddressableBits; + +BEGIN + +END constbool2. diff --git a/gcc/testsuite/gm2/iso/const/pass/constbool3.mod b/gcc/testsuite/gm2/iso/const/pass/constbool3.mod new file mode 100644 index 00000000000..e63ffc4d0b3 --- /dev/null +++ b/gcc/testsuite/gm2/iso/const/pass/constbool3.mod @@ -0,0 +1,12 @@ +MODULE constbool3 ; + + +CONST + AddressableBits = 32 ; + MaxBits = 16 ; + + BitsInUse = ORD(AddressableBits > MaxBits) * MaxBits + ORD(AddressableBits <= MaxBits) * AddressableBits; + +BEGIN + +END constbool3.