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 <gaiusmod2@gmail.com>

10 files changed, 173 insertions, 95 deletions

diff --git a/gcc/m2/gm2-compiler/M2ALU.mod b/gcc/m2/gm2-compiler/M2ALU.mod
index 58d4b5c..cfa3726 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 8d9b5a5..df07363 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 3e92e31..ad2ee86 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 1776a09..0558c78 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 2ffd74f..f8c2115 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 654ac04..50c2a48 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 3c9b953..cc1acce 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 2297663..4034dda 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 89e756d..fcb1ce6 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 0000000..ee3e926
--- /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.