https://gcc.gnu.org/g:f065c582d9c8e0a4fee7ee563c584ee3b1975bea
commit r14-9506-gf065c582d9c8e0a4fee7ee563c584ee3b1975bea
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Sun Mar 17 14:49:23 2024 +0000
PR modula2/114296 ICE when attempting to create a constant set with a
variable element
This patch corrects the virtual token creation for the aggregate constant
and also corrects tokens for constructor components.
gcc/m2/ChangeLog:
PR modula2/114296
* gm2-compiler/M2ALU.mod (ElementsSolved): Add tokenno parameter.
Add constant checks and generate error messages.
(EvalSetValues): Pass tokenno parameter to ElementsSolved.
* gm2-compiler/M2LexBuf.mod (stop): New procedure.
(MakeVirtualTok): Call stop if caret = BadTokenNo.
* gm2-compiler/M2Quads.def (BuildNulExpression): Add tokpos
parameter.
(BuildSetStart): Ditto.
(BuildEmptySet): Ditto.
(BuildConstructorEnd): Add startpos parameter.
(BuildTypeForConstructor): Add tokpos parameter.
* gm2-compiler/M2Quads.mod (BuildNulExpression): Add tokpos
parameter and push tokpos to the quad stack.
(BuildSetStart): Add tokpos parameter and push tokpos.
(BuildSetEnd): Rewrite.
(BuildEmptySet): Add tokpos parameter and push tokpos with
the set type.
(BuildConstructorStart): Pop typepos.
(BuildConstructorEnd): Add startpos parameter.
Create valtok from startpos and cbratokpos.
(BuildTypeForConstructor): Add tokpos parameter.
* gm2-compiler/M2Range.def (InitAssignmentRangeCheck): Rename
d to des and e to expr.
Add destok and exprtok parameters.
* gm2-compiler/M2Range.mod (InitAssignmentRangeCheck): Rename
d to des and e to expr.
Add destok and exprtok parameters.
Save destok and exprtok into range record.
(FoldAssignment): Pass exprtok to TryDeclareConstant.
* gm2-compiler/P3Build.bnf (ComponentValue): Rewrite.
(Constructor): Rewrite.
(ConstSetOrQualidentOrFunction): Rewrite.
(SetOrQualidentOrFunction): Rewrite.
* gm2-compiler/PCBuild.bnf (ConstSetOrQualidentOrFunction): Rewrite.
(SetOrQualidentOrFunction): Rewrite.
* gm2-compiler/PHBuild.bnf (Constructor): Rewrite.
(ConstSetOrQualidentOrFunction): Rewrite.
gcc/testsuite/ChangeLog:
PR modula2/114296
* gm2/pim/fail/badtype2.mod: New test.
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2ALU.mod | 14 +++-
gcc/m2/gm2-compiler/M2LexBuf.mod | 13 +++-
gcc/m2/gm2-compiler/M2Quads.def | 15 ++--
gcc/m2/gm2-compiler/M2Quads.mod | 124 ++++++++++++++++++--------------
gcc/m2/gm2-compiler/M2Range.def | 4 +-
gcc/m2/gm2-compiler/M2Range.mod | 14 ++--
gcc/m2/gm2-compiler/P3Build.bnf | 48 ++++++++-----
gcc/m2/gm2-compiler/PCBuild.bnf | 11 +--
gcc/m2/gm2-compiler/PHBuild.bnf | 16 +++--
gcc/testsuite/gm2/pim/fail/badtype2.mod | 9 +++
10 files changed, 173 insertions(+), 95 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2ALU.mod b/gcc/m2/gm2-compiler/M2ALU.mod
index 58d4b5c24ed..cfa372671cd 100644
--- a/gcc/m2/gm2-compiler/M2ALU.mod
+++ b/gcc/m2/gm2-compiler/M2ALU.mod
@@ -2922,10 +2922,20 @@ END AddField ;
ElementsSolved - returns TRUE if all ranges in the set have been solved.
*)
-PROCEDURE ElementsSolved (r: listOfRange) : BOOLEAN ;
+PROCEDURE ElementsSolved (tokenno: CARDINAL; r: listOfRange) : BOOLEAN ;
BEGIN
WHILE r#NIL DO
WITH r^ DO
+ IF NOT IsConst (low)
+ THEN
+ MetaErrorT1 (tokenno, 'a constant set can only contain constant
set elements, {%1Ead} is not a constant',
+ low)
+ END ;
+ IF (high # low) AND (NOT IsConst (high))
+ THEN
+ MetaErrorT1 (tokenno, 'a constant set can only contain constant
set elements, {%1Ead} is not a constant',
+ high)
+ END ;
IF NOT (IsSolvedGCC(low) AND IsSolvedGCC(high))
THEN
RETURN( FALSE )
@@ -3088,7 +3098,7 @@ END CombineElements ;
PROCEDURE EvalSetValues (tokenno: CARDINAL; r: listOfRange) : BOOLEAN ;
BEGIN
- IF ElementsSolved(r)
+ IF ElementsSolved (tokenno, r)
THEN
SortElements(tokenno, r) ;
CombineElements(tokenno, r) ;
diff --git a/gcc/m2/gm2-compiler/M2LexBuf.mod b/gcc/m2/gm2-compiler/M2LexBuf.mod
index 8d9b5a5a6e3..df073630bc1 100644
--- a/gcc/m2/gm2-compiler/M2LexBuf.mod
+++ b/gcc/m2/gm2-compiler/M2LexBuf.mod
@@ -48,6 +48,7 @@ CONST
Tracing = FALSE ;
Debugging = FALSE ;
DebugRecover = FALSE ;
+ BadTokenNo = 32579 ;
InitialSourceToken = 2 ; (* 0 is unknown, 1 is builtin. *)
TYPE
@@ -81,6 +82,10 @@ VAR
to OpenSource. *)
+PROCEDURE stop ;
+END stop ;
+
+
(*
InitTokenDesc - returns a TokenDesc filled in with the parameters and
the insert field set to NIL.
@@ -1060,10 +1065,14 @@ BEGIN
AddTokToList (virtualrangetok, NulName, 0,
descLeft^.line, descLeft^.col, descLeft^.file,
GetLocationBinary (lc, ll, lr)) ;
- RETURN HighIndice (ListOfTokens)
+ caret := HighIndice (ListOfTokens)
END
END
END ;
+ IF caret = BadTokenNo
+ THEN
+ stop
+ END ;
RETURN caret
END MakeVirtualTok ;
@@ -1075,7 +1084,7 @@ END MakeVirtualTok ;
PROCEDURE MakeVirtual2Tok (left, right: CARDINAL) : CARDINAL ;
BEGIN
- RETURN MakeVirtualTok (left, left, right)
+ RETURN MakeVirtualTok (left, left, right) ;
END MakeVirtual2Tok ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index 3e92e3181dc..ad2ee869846 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -1934,9 +1934,10 @@ PROCEDURE BuildDesignatorPointer (ptrtok: CARDINAL) ;
Empty +------------+
| NulSym |
|------------|
+ tokpos is the position of the RETURN token.
*)
-PROCEDURE BuildNulExpression ;
+PROCEDURE BuildNulExpression (tokpos: CARDINAL) ;
(*
@@ -1953,7 +1954,7 @@ PROCEDURE BuildNulExpression ;
|--------------|
*)
-PROCEDURE BuildSetStart ;
+PROCEDURE BuildSetStart (tokpos: CARDINAL) ;
(*
@@ -1986,9 +1987,10 @@ PROCEDURE BuildSetEnd ;
| SetType | | SetType |
|-----------| |-------------|
+ tokpos points to the opening '{'.
*)
-PROCEDURE BuildEmptySet ;
+PROCEDURE BuildEmptySet (tokpos: CARDINAL) ;
(*
@@ -2097,9 +2099,12 @@ PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ;
+------------+ +------------+
| const | | const |
|------------+ |------------|
+
+ startpos is the start of the constructor, either the typename or '{'
+ cbratokpos is the '}'.
*)
-PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
+PROCEDURE BuildConstructorEnd (startpos, cbratokpos: CARDINAL) ;
(*
@@ -2116,7 +2121,7 @@ PROCEDURE NextConstructorField ;
it Pushes a Bitset type.
*)
-PROCEDURE BuildTypeForConstructor ;
+PROCEDURE BuildTypeForConstructor (tokpos: CARDINAL) ;
(*
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 1776a09b41f..0558c782101 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -147,7 +147,7 @@ FROM M2Comp IMPORT CompilingImplementationModule,
CompilingProgramModule ;
FROM M2LexBuf IMPORT currenttoken, UnknownTokenNo, BuiltinTokenNo,
- GetToken, MakeVirtualTok,
+ GetToken, MakeVirtualTok, MakeVirtual2Tok,
GetFileName, TokenToLineNo, GetTokenName,
GetTokenNo, GetLineNo, GetPreviousTokenLineNo,
PrintTokenNo ;
@@ -3702,7 +3702,7 @@ BEGIN
THEN
(* Tell code generator to test runtime values of assignment so ensure
we
catch overflow and underflow. *)
- BuildRange (InitAssignmentRangeCheck (combinedtok, Des, Exp))
+ BuildRange (InitAssignmentRangeCheck (combinedtok, Des, Exp, destok,
exptok))
END ;
IF checkTypes
THEN
@@ -11825,11 +11825,12 @@ END BuildAccessWithField ;
Empty +------------+
| NulSym |
|------------|
+ tokpos is the position of the RETURN token.
*)
-PROCEDURE BuildNulExpression ;
+PROCEDURE BuildNulExpression (tokpos: CARDINAL) ;
BEGIN
- PushT(NulSym)
+ PushTtok (NulSym, tokpos)
END BuildNulExpression ;
@@ -11839,25 +11840,25 @@ END BuildNulExpression ;
it Pushes a Bitset type.
*)
-PROCEDURE BuildTypeForConstructor ;
+PROCEDURE BuildTypeForConstructor (tokpos: CARDINAL) ;
VAR
c: ConstructorFrame ;
BEGIN
IF NoOfItemsInStackAddress(ConstructorStack)=0
THEN
- PushT(Bitset)
+ PushTtok (Bitset, tokpos)
ELSE
c := PeepAddress(ConstructorStack, 1) ;
WITH c^ DO
- IF IsArray(type) OR IsSet(type)
+ IF IsArray (type) OR IsSet (type)
THEN
- PushT(GetSType(type))
- ELSIF IsRecord(type)
+ PushTtok (GetSType (type), tokpos)
+ ELSIF IsRecord (type)
THEN
- PushT(GetSType(GetNth(type, index)))
+ PushTtok (GetSType (GetNth (type, index)), tokpos)
ELSE
- MetaError1('{%1ad} is not a set, record or array type which is
expected when constructing an aggregate entity',
- type)
+ MetaError1 ('{%1ad} is not a set, record or array type which is
expected when constructing an aggregate entity',
+ type)
END
END
END
@@ -11878,9 +11879,9 @@ END BuildTypeForConstructor ;
|--------------|
*)
-PROCEDURE BuildSetStart ;
+PROCEDURE BuildSetStart (tokpos: CARDINAL) ;
BEGIN
- PushT(Bitset)
+ PushTtok (Bitset, tokpos)
END BuildSetStart ;
@@ -11900,12 +11901,15 @@ END BuildSetStart ;
PROCEDURE BuildSetEnd ;
VAR
- v, t: CARDINAL ;
+ valuepos, typepos,
+ combined,
+ value, type : CARDINAL ;
BEGIN
- PopT(v) ;
- PopT(t) ;
- PushTF(v, t) ;
- Assert(IsSet(t))
+ PopTtok (value, valuepos) ;
+ PopTtok (type, typepos) ;
+ combined := MakeVirtual2Tok (typepos, valuepos) ;
+ PushTFtok (value, type, combined) ;
+ Assert (IsSet (type))
END BuildSetEnd ;
@@ -11922,52 +11926,54 @@ END BuildSetEnd ;
| SetType | | SetType |
|-----------| |-------------|
+ tokpos points to the opening '{'.
*)
-PROCEDURE BuildEmptySet ;
+PROCEDURE BuildEmptySet (tokpos: CARDINAL) ;
VAR
- n : Name ;
- Type : CARDINAL ;
- NulSet: CARDINAL ;
- tok : CARDINAL ;
+ n : Name ;
+ typepos,
+ Type : CARDINAL ;
+ NulSet : CARDINAL ;
+ tok : CARDINAL ;
BEGIN
- PopT(Type) ; (* type of set we are building *)
- tok := GetTokenNo () ;
- IF (Type=NulSym) AND Pim
+ PopTtok (Type, typepos) ; (* type of set we are building *)
+ IF (Type = NulSym) AND Pim
THEN
(* allowed generic {} in PIM Modula-2 *)
- ELSIF IsUnknown(Type)
+ typepos := tokpos
+ ELSIF IsUnknown (Type)
THEN
- n := GetSymName(Type) ;
- WriteFormat1('set type %a is undefined', n) ;
+ n := GetSymName (Type) ;
+ WriteFormat1 ('set type %a is undefined', n) ;
Type := Bitset
- ELSIF NOT IsSet(SkipType(Type))
+ ELSIF NOT IsSet (SkipType (Type))
THEN
- n := GetSymName(Type) ;
+ n := GetSymName (Type) ;
WriteFormat1('expecting a set type %a', n) ;
Type := Bitset
ELSE
- Type := SkipType(Type) ;
- Assert((Type#NulSym))
+ Type := SkipType (Type) ;
+ Assert (Type # NulSym)
END ;
- NulSet := MakeTemporary(tok, ImmediateValue) ;
- PutVar(NulSet, Type) ;
- PutConstSet(NulSet) ;
+ NulSet := MakeTemporary (typepos, ImmediateValue) ;
+ PutVar (NulSet, Type) ;
+ PutConstSet (NulSet) ;
IF CompilerDebugging
THEN
- n := GetSymName(Type) ;
- printf1('set type = %a\n', n)
+ n := GetSymName (Type) ;
+ printf1 ('set type = %a\n', n)
END ;
- PushNulSet(Type) ; (* onto the ALU stack *)
- PopValue(NulSet) ; (* ALU -> symbol table *)
+ PushNulSet (Type) ; (* onto the ALU stack *)
+ PopValue (NulSet) ; (* ALU -> symbol table *)
(* and now construct the M2Quads stack as defined by the comments above *)
- PushT(Type) ;
- PushT(NulSet) ;
+ PushTtok (Type, typepos) ;
+ PushTtok (NulSet, typepos) ;
IF CompilerDebugging
THEN
- n := GetSymName(Type) ;
- printf2('Type = %a (%d) built empty set\n', n, Type) ;
+ n := GetSymName (Type) ;
+ printf2 ('Type = %a (%d) built empty set\n', n, Type) ;
DisplayStack (* Debugging info *)
END
END BuildEmptySet ;
@@ -12197,10 +12203,11 @@ END SilentBuildConstructorStart ;
PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ;
VAR
+ typepos,
constValue,
type : CARDINAL ;
BEGIN
- PopT (type) ; (* we ignore the type as we already have the constructor
symbol from pass C *)
+ PopTtok (type, typepos) ; (* we ignore the type as we already have the
constructor symbol from pass C *)
GetConstructorFromFifoQueue (constValue) ;
IF type # GetSType (constValue)
THEN
@@ -12224,25 +12231,34 @@ END BuildConstructorStart ;
+------------+ +------------+
| const | | const |
|------------| |------------|
+
+ startpos is the start of the constructor, either the typename or '{'
+ cbratokpos is the '}'.
*)
-PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
+PROCEDURE BuildConstructorEnd (startpos, cbratokpos: CARDINAL) ;
VAR
typetok,
value, valtok: CARDINAL ;
BEGIN
+ IF DebugTokPos
+ THEN
+ WarnStringAt (InitString ('startpos'), startpos) ;
+ WarnStringAt (InitString ('cbratokpos'), cbratokpos)
+ END ;
PopTtok (value, valtok) ;
- IF IsBoolean (1)
+ IF DebugTokPos
THEN
- typetok := valtok
- ELSE
- typetok := OperandTtok (1)
+ WarnStringAt (InitString ('value valtok'), valtok)
END ;
- valtok := MakeVirtualTok (typetok, typetok, cbratokpos) ;
+ valtok := MakeVirtual2Tok (startpos, cbratokpos) ;
PutDeclared (valtok, value) ;
PushTtok (value, valtok) ; (* Use valtok as we now know it was a
constructor. *)
- PopConstructor
- (* ; ErrorStringAt (Mark (InitString ('aggregate constant')), valtok) *)
+ PopConstructor ;
+ IF DebugTokPos
+ THEN
+ WarnStringAt (InitString ('aggregate constant'), valtok)
+ END
END BuildConstructorEnd ;
diff --git a/gcc/m2/gm2-compiler/M2Range.def b/gcc/m2/gm2-compiler/M2Range.def
index 2ffd74f2c37..f8c21156674 100644
--- a/gcc/m2/gm2-compiler/M2Range.def
+++ b/gcc/m2/gm2-compiler/M2Range.def
@@ -51,7 +51,9 @@ FROM DynamicStrings IMPORT String ;
can be generated later on.
*)
-PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL; d, e: CARDINAL) :
CARDINAL ;
+PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL;
+ des, expr: CARDINAL;
+ destok, exprtok: CARDINAL) : CARDINAL ;
(*
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
index 654ac046c6f..50c2a48fe7f 100644
--- a/gcc/m2/gm2-compiler/M2Range.mod
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -601,16 +601,22 @@ END PutRangeArraySubscript ;
(*
InitAssignmentRangeCheck - returns a range check node which
remembers the information necessary
- so that a range check for d := e
+ so that a range check for des := expr
can be generated later on.
*)
-PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL; d, e: CARDINAL) :
CARDINAL ;
+PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL;
+ des, expr: CARDINAL;
+ destok, exprtok: CARDINAL) : CARDINAL ;
VAR
r: CARDINAL ;
+ p: Range ;
BEGIN
r := InitRange () ;
- Assert (PutRange (tokno, GetIndice (RangeIndex, r), assignment, d, e) #
NIL) ;
+ p := GetIndice (RangeIndex, r) ;
+ Assert (PutRange (tokno, p, assignment, des, expr) # NIL) ;
+ p^.destok := destok ;
+ p^.exprtok := exprtok ;
RETURN r
END InitAssignmentRangeCheck ;
@@ -1207,7 +1213,7 @@ VAR
BEGIN
p := GetIndice (RangeIndex, r) ;
WITH p^ DO
- TryDeclareConstant (tokenNo, expr) ;
+ TryDeclareConstant (exprtok, expr) ;
IF desLowestType # NulSym
THEN
IF AssignmentTypeCompatible (tokenno, "", des, expr)
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index 3c9b9534647..cc1accef1a0 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -739,10 +739,15 @@ ComponentElement := ConstExpression ( ".."
ConstExpression % Pus
)
=:
-ComponentValue := ComponentElement ( 'BY' ConstExpression %
PushTtok(ByTok, GetTokenNo() -1) %
+ComponentValue := %
VAR tokpos: CARDINAL ; %
+ (
+ %
tokpos := GetTokenNo () %
+ ComponentElement ( %
tokpos := GetTokenNo () %
+ 'BY' ConstExpression %
PushTtok (ByTok, tokpos) %
- | %
PushT(NulTok) %
- )
+ | %
PushTtok (NulTok, tokpos) %
+ )
+ )
=:
ArraySetRecordValue := ComponentValue %
BuildComponentValue %
@@ -751,16 +756,22 @@ ArraySetRecordValue := ComponentValue
% Bui
}
=:
-Constructor := %
DisplayStack %
- '{' %
BuildConstructorStart (GetTokenNo() -1) %
- [ ArraySetRecordValue ] %
BuildConstructorEnd (GetTokenNo()) %
+Constructor := %
VAR tokpos: CARDINAL ; %
+ %
DisplayStack %
+ '{' %
tokpos := GetTokenNo () -1 %
+ %
BuildConstructorStart (tokpos) %
+ [ ArraySetRecordValue ] %
BuildConstructorEnd (tokpos, GetTokenNo()) %
'}' =:
-ConstSetOrQualidentOrFunction := Qualident
- [ Constructor | ConstActualParameters %
BuildConstFunctionCall %
- ]
- | %
BuildTypeForConstructor %
- Constructor =:
+ConstSetOrQualidentOrFunction := %
VAR tokpos: CARDINAL ; %
+ %
tokpos := GetTokenNo () %
+ (
+ Qualident
+ [ Constructor | ConstActualParameters %
BuildConstFunctionCall %
+ ]
+ | %
BuildTypeForConstructor (tokpos) %
+ Constructor
+ ) =:
ConstActualParameters := %
PushInConstExpression %
ActualParameters %
PopInConstExpression %
@@ -1101,10 +1112,13 @@ Factor :=
% VAR
| ConstAttribute
) =:
-SetOrDesignatorOrFunction := Qualident
- %
Assert (OperandTok(1) # UnknownTokenNo) %
+SetOrDesignatorOrFunction := %
VAR tokpos: CARDINAL ; %
+ %
tokpos := GetTokenNo () %
+ (
+ Qualident
+ %
Assert (OperandTok (1) # UnknownTokenNo) %
%
CheckWithReference %
- %
Assert (OperandTok(1) # UnknownTokenNo) %
+ %
Assert (OperandTok (1) # UnknownTokenNo) %
[ Constructor |
SimpleDes %
(* Assert (OperandTok(1) # UnknownTokenNo) *) %
[ ActualParameters %
IF IsInConstExpression()
@@ -1115,8 +1129,8 @@ SetOrDesignatorOrFunction := Qualident
END %
]
] |
- %
BuildTypeForConstructor %
- Constructor =:
+ %
BuildTypeForConstructor (tokpos) %
+ Constructor ) =:
-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
SimpleDes := { SubDesignator } =:
@@ -1130,7 +1144,7 @@ ExitStatement := "EXIT"
% Bui
ReturnStatement := "RETURN" %
VAR tokno: CARDINAL ; %
%
tokno := GetTokenNo () -1 %
- ( Expression | %
BuildNulExpression (* in epsilon *) %
+ ( Expression | %
BuildNulExpression (tokno) %
) %
BuildReturn (tokno) %
=:
diff --git a/gcc/m2/gm2-compiler/PCBuild.bnf b/gcc/m2/gm2-compiler/PCBuild.bnf
index 2297663ef27..4034dda245a 100644
--- a/gcc/m2/gm2-compiler/PCBuild.bnf
+++ b/gcc/m2/gm2-compiler/PCBuild.bnf
@@ -700,12 +700,13 @@ ConstructorOrConstActualParameters := Constructor |
ConstActualParameters % Pus
-- the entry to Constructor
ConstSetOrQualidentOrFunction := %
PushAutoOff %
- (
+ %
VAR tokpos: CARDINAL ; %
+ ( %
tokpos := GetTokenNo () %
PushQualident
( ConstructorOrConstActualParameters | %
PushConstType %
%
PopNothing %
)
- | %
BuildTypeForConstructor %
+ | %
BuildTypeForConstructor (tokpos) %
Constructor ) %
PopAuto %
=:
@@ -1003,12 +1004,14 @@ ConstructorOrSimpleDes := Constructor |
% Pop
=:
SetOrDesignatorOrFunction := %
PushAutoOff %
- (
+ %
VAR tokpos: CARDINAL ; %
+
+ ( %
tokpos := GetTokenNo () %
PushQualident
( ConstructorOrSimpleDes | %
PopNothing %
)
|
- %
BuildTypeForConstructor %
+ %
BuildTypeForConstructor (tokpos) %
Constructor
) %
PopAuto %
=:
diff --git a/gcc/m2/gm2-compiler/PHBuild.bnf b/gcc/m2/gm2-compiler/PHBuild.bnf
index 89e756d4f87..fcb1ce6092a 100644
--- a/gcc/m2/gm2-compiler/PHBuild.bnf
+++ b/gcc/m2/gm2-compiler/PHBuild.bnf
@@ -652,19 +652,23 @@ ArraySetRecordValue := ComponentValue
% Bui
}
=:
-Constructor := '{' %
BuildConstructorStart (GetTokenNo() -1) %
- [ ArraySetRecordValue ] %
BuildConstructorEnd (GetTokenNo()) %
+Constructor := %
VAR tokpos: CARDINAL ; %
+ %
DisplayStack %
+ '{' %
tokpos := GetTokenNo () -1 %
+ %
BuildConstructorStart (tokpos) %
+ [ ArraySetRecordValue ] %
BuildConstructorEnd (tokpos, GetTokenNo()) %
'}' =:
-ConstSetOrQualidentOrFunction := %
PushAutoOn %
- (
+ConstSetOrQualidentOrFunction := %
PushAutoOn %
+ %
VAR tokpos: CARDINAL ; %
+ ( %
tokpos := GetTokenNo () %
Qualident
[ Constructor |
ConstActualParameters %
BuildConstFunctionCall %
]
- | %
BuildTypeForConstructor %
+ | %
BuildTypeForConstructor (tokpos) %
Constructor
- ) %
PopAuto %
+ ) %
PopAuto %
=:
ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "("
ConstAttributeExpression ")" ")" =:
diff --git a/gcc/testsuite/gm2/pim/fail/badtype2.mod
b/gcc/testsuite/gm2/pim/fail/badtype2.mod
new file mode 100644
index 00000000000..ee3e9265190
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badtype2.mod
@@ -0,0 +1,9 @@
+MODULE badtype2 ;
+
+VAR
+ x: CARDINAL ;
+ ch: CHAR ;
+BEGIN
+ x := 6 ;
+ ch := {7 .. x};
+END badtype2.
