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.
