https://gcc.gnu.org/g:a2f60c1ff5a85497f84dc307301bcbc4bd77082e
commit r15-7668-ga2f60c1ff5a85497f84dc307301bcbc4bd77082e
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Sat Feb 22 16:47:21 2025 +0000
PR modula2/118978 ICE when attempting to pass an incompatible parameter
This bugfix is for a an ICE which occurs if an incompatible parameter
is passed to a procedure. In particular if a REAL constant actual
parameter is passed to INTEGER formal parameter then M2Range is invoked
to check the type and then M2Range is called to check the value range.
The value range check causes an ICE. The bug fix introduces range
dependencies on type checks. If the type check fails an
error message is generated and any future range check cancelled.
These range and type checks are tightly coupled when generating
parameter quad intermediate code.
gcc/m2/ChangeLog:
PR modula2/118978
* gm2-compiler/M2Check.mod (checkConstMeta): Add check for
typed constants.
* gm2-compiler/M2Quads.mod (BoolFrame): New field RangeDep.
(CheckProcedureParameters): Call PutRangeDep to associate the
range dependency with the parameter on the quad stack.
Pass ParamCheckId to CheckParameter.
(CheckProcTypeAndProcedure): Add ParamCheckId parameter.
Pass ParamCheckId to BuildRange.
(CheckParameter): New parameter ParamCheckId.
Pass ParamCheckId to CheckProcTypeAndProcedure.
(CheckParameterOrdinals): Add extra range dep parameter to the
call of InitParameterRangeCheck.
(ConvertBooleanToVariable): Initialize RangeDep field.
(PushBacktok): Ditto.
(OperandRangeDep): New procedure.
(PutRangeDep): Ditto.
* gm2-compiler/M2Range.def (InitTypesParameterCheck): Add new
parameter depRangeId.
(InitParameterRangeCheck): Add new parameter parentRangeId.
(FoldRangeCheck): Add new parameter range.
* gm2-compiler/M2Range.mod (InitTypesParameterCheck): Add new
parameter depRangeId.
(InitParameterRangeCheck): Add new parameter parentRangeId.
(FoldRangeCheck): Add new parameter range and rewrite.
(FoldRangeCheckLower): New procedure.
(Range): New field cancelled.
New field dependantid.
(PutRangeParam): Initialize dependantid.
(PutRangeParamAssign): Ditto.
(CheckCancelled): New procedure.
(Cancel): Ditto.
(IsCancelled): New procedure function.
(FoldTypeParam): Add depRangeId parameter.
(WriteRangeCheck): Add dependent debugging.
gcc/testsuite/ChangeLog:
PR modula2/118978
* gm2/pim/fail/badparamtype.mod: New test.
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Check.mod | 6 +
gcc/m2/gm2-compiler/M2Quads.mod | 64 +++++++---
gcc/m2/gm2-compiler/M2Range.def | 15 +--
gcc/m2/gm2-compiler/M2Range.mod | 186 ++++++++++++++++++++++------
gcc/testsuite/gm2/pim/fail/badparamtype.mod | 10 ++
5 files changed, 219 insertions(+), 62 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index d2bb4ab7da35..528c51deaf36 100644
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -768,6 +768,7 @@ END checkVarEquivalence ;
PROCEDURE checkConstMeta (result: status; tinfo: tInfo;
left, right: CARDINAL) : status ;
VAR
+ typeLeft,
typeRight: CARDINAL ;
BEGIN
Assert (IsConst (left)) ;
@@ -798,6 +799,11 @@ BEGIN
RETURN doCheckPair (result, tinfo, Char, typeRight)
END
END
+ ELSIF IsTyped (left) AND IsTyped (right)
+ THEN
+ typeRight := GetDType (right) ;
+ typeLeft := GetDType (left) ;
+ RETURN doCheckPair (result, tinfo, typeLeft, typeRight)
END ;
RETURN result
END checkConstMeta ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 46db4a6556da..d057a27fd862 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -300,6 +300,7 @@ TYPE
Dimension : CARDINAL ;
ReadWrite : CARDINAL ;
name : CARDINAL ;
+ RangeDep : CARDINAL ;
Annotation: String ;
tokenno : CARDINAL ;
END ;
@@ -5623,6 +5624,7 @@ VAR
proctok,
paramtok : CARDINAL ;
n1, n2 : Name ;
+ ParamCheckId,
Dim,
Actual,
FormalI,
@@ -5686,8 +5688,11 @@ BEGIN
s := InitString ('actual') ;
WarnStringAt (s, paramtok)
END ;
-
- BuildRange (InitTypesParameterCheck (paramtok, Proc, i, FormalI,
Actual)) ;
+ ParamCheckId := InitTypesParameterCheck (paramtok, Proc, i, FormalI,
Actual, 0) ;
+ BuildRange (ParamCheckId) ;
+ (* Store the ParamCheckId on the quad stack so that any dependant
checks
+ can be cancelled if the type check above detects an error. *)
+ PutRangeDep (pi, ParamCheckId) ;
IF IsConst(Actual)
THEN
IF IsVarParamAny (Proc, i)
@@ -5706,7 +5711,7 @@ BEGIN
(* Allow string literals to be passed to ARRAY [0..n] OF
CHAR. *)
ELSIF (GetStringLength(paramtok, Actual) = 1) (* If = 1 then
it maybe treated as a char. *)
THEN
- CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL)
+ CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i,
NIL, ParamCheckId)
ELSIF NOT IsUnboundedParamAny (Proc, i)
THEN
IF IsForC AND (GetSType(FormalI)=Address)
@@ -5722,7 +5727,7 @@ BEGIN
END
END
ELSE
- CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL)
+ CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL,
ParamCheckId)
END
ELSE
IF IsForC AND UsesVarArgs(Proc)
@@ -5752,7 +5757,8 @@ END CheckProcedureParameters ;
CheckProcTypeAndProcedure - checks the ProcType with the call.
*)
-PROCEDURE CheckProcTypeAndProcedure (tokno: CARDINAL; ProcType: CARDINAL;
call: CARDINAL) ;
+PROCEDURE CheckProcTypeAndProcedure (tokno: CARDINAL; ProcType: CARDINAL;
+ call: CARDINAL; ParamCheckId: CARDINAL) ;
VAR
n1, n2 : Name ;
i, n, t : CARDINAL ;
@@ -5793,8 +5799,7 @@ BEGIN
END ;
BuildRange (InitTypesParameterCheck (tokno, CheckedProcedure, i,
GetParam (CheckedProcedure, i),
- GetParam (ProcType, i))) ;
- (* CheckParameter(tokpos, GetParam(CheckedProcedure, i), 0,
GetParam(ProcType, i), call, i, TypeList) ; *)
+ GetParam (ProcType, i),
ParamCheckId)) ;
INC(i)
END
END
@@ -5911,7 +5916,7 @@ END LegalUnboundedParam ;
PROCEDURE CheckParameter (tokpos: CARDINAL;
Actual, Dimension, Formal, ProcSym: CARDINAL;
- i: CARDINAL; TypeList: List) ;
+ i: CARDINAL; TypeList: List; ParamCheckId: CARDINAL)
;
VAR
NewList : BOOLEAN ;
ActualType, FormalType: CARDINAL ;
@@ -5991,7 +5996,7 @@ BEGIN
END
END ;
(* now to check each parameter of the proc type *)
- CheckProcTypeAndProcedure (tokpos, FormalType, Actual)
+ CheckProcTypeAndProcedure (tokpos, FormalType, Actual, ParamCheckId)
ELSIF (ActualType#FormalType) AND (ActualType#NulSym)
THEN
IF IsUnknown(FormalType)
@@ -6657,9 +6662,10 @@ BEGIN
THEN
IF NOT IsSet (GetDType (FormalI))
THEN
- (* tell code generator to test runtime values of assignment so
ensure we
- catch overflow and underflow *)
- BuildRange (InitParameterRangeCheck (tokno, Proc, i, FormalI,
Actual))
+ (* Tell the code generator to test the runtime values of the
assignment
+ so ensure we catch overflow and underflow. *)
+ BuildRange (InitParameterRangeCheck (tokno, Proc, i, FormalI,
Actual,
+ OperandRangeDep (pi)))
END
END
END ;
@@ -13108,7 +13114,8 @@ BEGIN
ReadWrite := NulSym ;
tokenno := tok ;
Annotation := KillString (Annotation) ;
- Annotation := InitString ('%1s(%1d)|%2s(%2d)||boolean var|type')
+ Annotation := InitString ('%1s(%1d)|%2s(%2d)||boolean var|type') ;
+ RangeDep := 0
END
END ConvertBooleanToVariable ;
@@ -14443,7 +14450,8 @@ BEGIN
FalseExit := False ;
BooleanOp := TRUE ;
tokenno := tokno ;
- Annotation := NIL
+ Annotation := NIL ;
+ RangeDep := 0
END ;
PushAddress (BoolStack, f) ;
Annotate ('<q%1d>|<q%2d>||true quad|false quad')
@@ -14585,6 +14593,34 @@ BEGIN
END OperandTok ;
+(*
+ OperandRangeDep - return the range dependant associated with the quad stack.
+*)
+
+PROCEDURE OperandRangeDep (pos: CARDINAL) : CARDINAL ;
+VAR
+ f: BoolFrame ;
+BEGIN
+ Assert (NOT IsBoolean (pos)) ;
+ f := PeepAddress (BoolStack, pos) ;
+ RETURN f^.RangeDep
+END OperandRangeDep ;
+
+
+(*
+ PutRangeDep - assigns the quad stack pos RangeDep to dep.
+*)
+
+PROCEDURE PutRangeDep (pos: CARDINAL; dep: CARDINAL) ;
+VAR
+ f: BoolFrame ;
+BEGIN
+ Assert (NOT IsBoolean (pos)) ;
+ f := PeepAddress (BoolStack, pos) ;
+ f^.RangeDep := dep
+END PutRangeDep ;
+
+
(*
BuildCodeOn - generates a quadruple declaring that code should be
emmitted from henceforth.
diff --git a/gcc/m2/gm2-compiler/M2Range.def b/gcc/m2/gm2-compiler/M2Range.def
index f8133d140c5c..42aa14237c9e 100644
--- a/gcc/m2/gm2-compiler/M2Range.def
+++ b/gcc/m2/gm2-compiler/M2Range.def
@@ -265,8 +265,9 @@ PROCEDURE InitTypesAssignmentCheck (tokno: CARDINAL; d, e:
CARDINAL) : CARDINAL
*)
PROCEDURE InitTypesParameterCheck (tokno: CARDINAL;
- proc: CARDINAL; i: CARDINAL;
- formal, actual: CARDINAL) : CARDINAL ;
+ proc: CARDINAL; paramno: CARDINAL;
+ formal, actual: CARDINAL;
+ depRangeId: CARDINAL) : CARDINAL ;
(*
@@ -275,8 +276,9 @@ PROCEDURE InitTypesParameterCheck (tokno: CARDINAL;
*)
PROCEDURE InitParameterRangeCheck (tokno: CARDINAL;
- proc: CARDINAL; i: CARDINAL;
- formal, actual: CARDINAL) : CARDINAL ;
+ proc: CARDINAL; paramno: CARDINAL;
+ formal, actual: CARDINAL;
+ parentRangeId: CARDINAL) : CARDINAL ;
(*
@@ -304,11 +306,10 @@ PROCEDURE CodeRangeCheck (r: CARDINAL; function: String) ;
(*
- FoldRangeCheck - returns a Tree representing the code for a
- range test defined by, r.
+ FoldRangeCheck - attempts to resolve the range check.
*)
-PROCEDURE FoldRangeCheck (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+PROCEDURE FoldRangeCheck (tokenno: CARDINAL; quad: CARDINAL; range: CARDINAL) ;
(*
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
index a985684583f5..347012bf5f13 100644
--- a/gcc/m2/gm2-compiler/M2Range.mod
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -75,6 +75,7 @@ FROM M2LexBuf IMPORT UnknownTokenNo, GetTokenNo,
FindFileNameFromToken,
TokenToLineNo, TokenToColumnNo, TokenToLocation,
MakeVirtual2Tok ;
FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
FROM M2GCCDeclare IMPORT TryDeclareConstant, DeclareConstructor ;
FROM M2Quads IMPORT QuadOperator, PutQuad, SubQuad, WriteOperand ;
FROM SymbolConversion IMPORT GccKnowsAbout, Mod2Gcc ;
@@ -145,6 +146,8 @@ TYPE
errorReported : BOOLEAN ; (* error message reported
yet? *)
strict : BOOLEAN ; (* is it a comparison
expression? *)
isin : BOOLEAN ; (* expression created by
IN operator? *)
+ cancelled : BOOLEAN ; (* Has this range been
cancelled? *)
+ dependantid : CARDINAL ; (* The associated
dependant range test. *)
END ;
@@ -316,7 +319,9 @@ BEGIN
expr2tok := UnknownTokenNo ;
byconsttok := UnknownTokenNo ;
incrementquad := 0 ;
- errorReported := FALSE
+ errorReported := FALSE ;
+ cancelled := FALSE ;
+ dependantid := 0
END ;
PutIndice(RangeIndex, r, p)
END ;
@@ -555,7 +560,8 @@ END PutRangeUnary ;
*)
PROCEDURE PutRangeParam (tokno: CARDINAL; p: Range; t: TypeOfRange; proc:
CARDINAL;
- i: CARDINAL; formal, actual: CARDINAL) : Range ;
+ paramno: CARDINAL; formal, actual: CARDINAL;
+ depRangeId: CARDINAL) : Range ;
BEGIN
WITH p^ DO
type := t ;
@@ -564,11 +570,12 @@ BEGIN
desLowestType := NulSym ;
exprLowestType := NulSym ;
procedure := proc ;
- paramNo := i ;
+ paramNo := paramno ;
isLeftValue := FALSE ;
tokenNo := tokno ;
strict := FALSE ;
- isin := FALSE
+ isin := FALSE ;
+ dependantid := depRangeId
END ;
RETURN p
END PutRangeParam ;
@@ -805,13 +812,16 @@ END InitTypesAssignmentCheck ;
and, e, are parameter compatible.
*)
-PROCEDURE InitTypesParameterCheck (tokno: CARDINAL; proc: CARDINAL; i:
CARDINAL;
- formal, actual: CARDINAL) : CARDINAL ;
+PROCEDURE InitTypesParameterCheck (tokno: CARDINAL;
+ proc: CARDINAL; paramno: CARDINAL;
+ formal, actual: CARDINAL;
+ depRangeId: CARDINAL) : CARDINAL ;
VAR
r: CARDINAL ;
BEGIN
r := InitRange () ;
- Assert (PutRangeParam (tokno, GetIndice (RangeIndex, r), typeparam, proc,
i, formal, actual) # NIL) ;
+ Assert (PutRangeParam (tokno, GetIndice (RangeIndex, r), typeparam, proc,
+ paramno, formal, actual, depRangeId) # NIL) ;
RETURN r
END InitTypesParameterCheck ;
@@ -824,7 +834,7 @@ END InitTypesParameterCheck ;
*)
PROCEDURE PutRangeParamAssign (tokno: CARDINAL; p: Range; t: TypeOfRange;
proc: CARDINAL;
- i: CARDINAL; formal, actual: CARDINAL) : Range ;
+ i: CARDINAL; formal, actual: CARDINAL;
parentRangeId: CARDINAL) : Range ;
BEGIN
WITH p^ DO
type := t ;
@@ -836,7 +846,8 @@ BEGIN
paramNo := i ;
dimension := i ;
isLeftValue := FALSE ;
- tokenNo := tokno
+ tokenNo := tokno ;
+ dependantid := parentRangeId
END ;
RETURN( p )
END PutRangeParamAssign ;
@@ -847,13 +858,14 @@ END PutRangeParamAssign ;
are parameter compatible.
*)
-PROCEDURE InitParameterRangeCheck (tokno: CARDINAL; proc: CARDINAL; i:
CARDINAL;
- formal, actual: CARDINAL) : CARDINAL ;
+PROCEDURE InitParameterRangeCheck (tokno: CARDINAL; proc: CARDINAL; paramno:
CARDINAL;
+ formal, actual: CARDINAL; parentRangeId:
CARDINAL) : CARDINAL ;
VAR
r: CARDINAL ;
BEGIN
r := InitRange () ;
- Assert (PutRangeParamAssign (tokno, GetIndice (RangeIndex, r), paramassign,
proc, i, formal, actual) # NIL) ;
+ Assert (PutRangeParamAssign (tokno, GetIndice (RangeIndex, r), paramassign,
proc,
+ paramno, formal, actual, parentRangeId) # NIL)
;
RETURN r
END InitParameterRangeCheck ;
@@ -1241,6 +1253,64 @@ BEGIN
END FoldAssignment ;
+(*
+ CheckCancelled - check to see if the range has been cancelled and if so
remove quad.
+*)
+
+PROCEDURE CheckCancelled (range: CARDINAL; quad: CARDINAL) ;
+BEGIN
+ IF IsCancelled (range)
+ THEN
+ SubQuad (quad)
+ END
+END CheckCancelled ;
+
+
+(*
+ IsCancelled - return the cancelled flag associated with range.
+*)
+
+PROCEDURE IsCancelled (range: CARDINAL) : BOOLEAN ;
+VAR
+ p: Range ;
+BEGIN
+ p := GetIndice (RangeIndex, range) ;
+ WITH p^ DO
+ IF cancelled
+ THEN
+ RETURN TRUE
+ END ;
+ IF (dependantid # 0) AND IsCancelled (dependantid)
+ THEN
+ cancelled := TRUE
+ END ;
+ RETURN cancelled
+ END
+END IsCancelled ;
+
+
+(*
+ Cancel - set the cancelled flag in range.
+*)
+
+PROCEDURE Cancel (range: CARDINAL) ;
+VAR
+ p: Range ;
+BEGIN
+ IF range # 0
+ THEN
+ p := GetIndice (RangeIndex, range) ;
+ WITH p^ DO
+ IF NOT cancelled
+ THEN
+ cancelled := TRUE ;
+ Cancel (dependantid)
+ END
+ END
+ END
+END Cancel ;
+
+
(*
FoldParameterAssign -
*)
@@ -1699,7 +1769,10 @@ END FoldTypeAssign ;
The quad is removed if the check succeeds.
*)
-PROCEDURE FoldTypeParam (q: CARDINAL; tokenNo: CARDINAL; formal, actual,
procedure: CARDINAL; paramNo: CARDINAL) ;
+PROCEDURE FoldTypeParam (q: CARDINAL; tokenNo: CARDINAL;
+ formal, actual, procedure: CARDINAL;
+ paramNo: CARDINAL;
+ depRangeId: CARDINAL) ;
VAR
compatible: BOOLEAN ;
BEGIN
@@ -1724,6 +1797,8 @@ BEGIN
IF compatible
THEN
SubQuad(q)
+ ELSE
+ Cancel (depRangeId)
END
END FoldTypeParam ;
@@ -1836,7 +1911,7 @@ BEGIN
CASE type OF
typeassign: FoldTypeAssign(q, tokenNo, des, expr, r) |
- typeparam: FoldTypeParam(q, tokenNo, des, expr, procedure, paramNo)
|
+ typeparam: FoldTypeParam(q, tokenNo, des, expr, procedure, paramNo,
r) |
typeexpr: FoldTypeExpr(q, tokenNo, des, expr, strict, isin, r)
ELSE
@@ -2271,7 +2346,7 @@ END FoldZeroRem ;
(*
- FoldRangeCheck - attempts to resolve the range check, r.
+ FoldRangeCheck - attempts to resolve the range check.
If it evaluates to true then
it is replaced by an ErrorOp
elsif it evaluates to false then
@@ -2280,47 +2355,63 @@ END FoldZeroRem ;
it is left alone
*)
-PROCEDURE FoldRangeCheck (tokenno: CARDINAL; q: CARDINAL; r: CARDINAL) ;
+PROCEDURE FoldRangeCheck (tokenno: CARDINAL; quad: CARDINAL; range: CARDINAL) ;
+BEGIN
+ IF IsCancelled (range)
+ THEN
+ SubQuad (quad)
+ ELSE
+ FoldRangeCheckLower (tokenno, quad, range)
+ END
+END FoldRangeCheck ;
+
+
+(*
+ FoldRangeCheckLower - call the appropriate Fold procedure depending upon
the type
+ of range.
+*)
+
+PROCEDURE FoldRangeCheckLower (tokenno: CARDINAL; quad: CARDINAL; range:
CARDINAL) ;
VAR
p: Range ;
BEGIN
- p := GetIndice(RangeIndex, r) ;
+ p := GetIndice(RangeIndex, range) ;
WITH p^ DO
CASE type OF
- assignment : FoldAssignment(tokenno, q, r) |
- returnassignment : FoldReturn(tokenno, q, r) |
+ assignment : FoldAssignment(tokenno, quad, range) |
+ returnassignment : FoldReturn(tokenno, quad, range) |
(* subrangeassignment : | unused currently *)
- inc : FoldInc(tokenno, q, r) |
- dec : FoldDec(tokenno, q, r) |
- incl : FoldIncl(tokenno, q, r) |
- excl : FoldExcl(tokenno, q, r) |
- shift : FoldShift(tokenno, q, r) |
- rotate : FoldRotate(tokenno, q, r) |
- typeassign : FoldTypeCheck(tokenno, q, r) |
- typeparam : FoldTypeCheck(tokenno, q, r) |
- typeexpr : FoldTypeCheck(tokenno, q, r) |
- paramassign : FoldParameterAssign(tokenno, q, r) |
- staticarraysubscript : FoldStaticArraySubscript(tokenno, q, r) |
- dynamicarraysubscript: FoldDynamicArraySubscript(tokenno, q, r) |
- forloopbegin : FoldForLoopBegin(tokenno, q, r) |
- forloopto : FoldForLoopTo(tokenno, q, r) |
+ inc : FoldInc(tokenno, quad, range) |
+ dec : FoldDec(tokenno, quad, range) |
+ incl : FoldIncl(tokenno, quad, range) |
+ excl : FoldExcl(tokenno, quad, range) |
+ shift : FoldShift(tokenno, quad, range) |
+ rotate : FoldRotate(tokenno, quad, range) |
+ typeassign : FoldTypeCheck(tokenno, quad, range) |
+ typeparam : FoldTypeCheck(tokenno, quad, range) |
+ typeexpr : FoldTypeCheck(tokenno, quad, range) |
+ paramassign : FoldParameterAssign(tokenno, quad, range) |
+ staticarraysubscript : FoldStaticArraySubscript(tokenno, quad, range) |
+ dynamicarraysubscript: FoldDynamicArraySubscript(tokenno, quad, range) |
+ forloopbegin : FoldForLoopBegin(tokenno, quad, range) |
+ forloopto : FoldForLoopTo(tokenno, quad, range) |
forloopend : RETURN (* unable to fold anything at this point,
des, will be variable *) |
- pointernil : FoldNil(tokenno, q, r) |
+ pointernil : FoldNil(tokenno, quad, range) |
noreturn : RETURN (* nothing to fold *) |
noelse : RETURN (* nothing to fold *) |
- casebounds : FoldCaseBounds(tokenno, q, r) |
- wholenonposdiv : FoldNonPosDiv(tokenno, q, r) |
- wholenonposmod : FoldNonPosMod(tokenno, q, r) |
- wholezerodiv : FoldZeroDiv(tokenno, q, r) |
- wholezerorem : FoldZeroRem(tokenno, q, r) |
- none : SubQuad(q)
+ casebounds : FoldCaseBounds(tokenno, quad, range) |
+ wholenonposdiv : FoldNonPosDiv(tokenno, quad, range) |
+ wholenonposmod : FoldNonPosMod(tokenno, quad, range) |
+ wholezerodiv : FoldZeroDiv(tokenno, quad, range) |
+ wholezerorem : FoldZeroRem(tokenno, quad, range) |
+ none : SubQuad(quad)
ELSE
InternalError ('unexpected case')
END
END
-END FoldRangeCheck ;
+END FoldRangeCheckLower ;
(*
@@ -3595,6 +3686,19 @@ VAR
BEGIN
p := GetIndice(RangeIndex, r) ;
WITH p^ DO
+ WriteString ('range ') ;
+ WriteCard (r, 0) ;
+ WriteString (' ') ;
+ IF cancelled
+ THEN
+ WriteString ('cancelled ')
+ END ;
+ IF dependantid # 0
+ THEN
+ WriteString ('dep ') ;
+ WriteCard (dependantid, 0) ;
+ WriteString (' ')
+ END ;
CASE type OF
assignment : WriteString('assignment (') ; WriteOperand(des)
; WriteString(', ') ; WriteOperand(expr) |
diff --git a/gcc/testsuite/gm2/pim/fail/badparamtype.mod
b/gcc/testsuite/gm2/pim/fail/badparamtype.mod
new file mode 100644
index 000000000000..17f6821ce56e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badparamtype.mod
@@ -0,0 +1,10 @@
+MODULE badparamtype ;
+
+PROCEDURE foo (i: INTEGER) ;
+BEGIN
+
+END foo ;
+
+BEGIN
+ foo (3.14)
+END badparamtype.
