PR modula2/117660: Errors referring to variables of type array could display full...

This patch ensures that the tokens defining the full declaration of an
ARRAY type is stored in the symbol table and used during production of
error messages.

gcc/m2/ChangeLog:

	PR modula2/117660
	* gm2-compiler/P2Build.bnf (ArrayType): Update tok with the
	composite token produced during array type declaration.
	* gm2-compiler/P2SymBuild.mod (EndBuildArray): Create the
	combinedtok and store it into the symbol table.
	Also ensure combinedtok is pushed to the quad stack.
	(BuildFieldArray): Preserve typetok.
	* gm2-compiler/SymbolTable.def (PutArray): Rename parameters.
	* gm2-compiler/SymbolTable.mod (PutArray): Rename parameters.

gcc/testsuite/ChangeLog:

	PR modula2/117660
	* gm2/iso/fail/arraymismatch.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

diff --git a/gcc/m2/gm2-compiler/P2Build.bnf b/gcc/m2/gm2-compiler/P2Build.bnf
index 9e1145e3f815fa012d91f1c3e0b0c6622bc9085c..e3db5f077dc65650b1083081f4f88e42a1ad267f 100644 (file)
--- a/gcc/m2/gm2-compiler/P2Build.bnf
+++ b/gcc/m2/gm2-compiler/P2Build.bnf
@@ -54,6 +54,7 @@ FROM M2Printf IMPORT printf0 ;
 FROM M2Debug IMPORT Assert ;
 
 FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, OperandT, PushTFA, Top, Annotate,
+                    OperandTok,
                     PushTFtok, PopTFtok, PushTFAtok, PopTtok, PushTtok,
                     StartBuildInit,
                     EndBuildInit,
@@ -783,8 +784,9 @@ ArrayType := "ARRAY"                                                       % VAR
                 SimpleType                                                 % BuildFieldArray ; %
               } "OF"                                                       % BuildNulName ; %
              Type                                                          % EndBuildArray ;
+                                                                             tok := OperandTok (1) ;
                                                                              PopNothing ;
-                                                                             PushTtok(arrayType, tok) %
+                                                                             PushTtok (arrayType, tok) %
            =:
 
 RecordType := "RECORD"                                                     % BuildRecord %

diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod
index 70492705129b5111a99f6e77cae2b6132f06a75d..288d0cac03bd13c661ffccddd592b4f79d32833b 100644 (file)
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -1281,7 +1281,7 @@ BEGIN
             THEN
                IF isunknown
                THEN
-                  MetaError2('attempting to declare a type {%1ad} to a type which is itself unknown {%2ad}',
+                  MetaError2('attempting to declare a type {%1ad} to a type which is itself and also unknown {%2ad}',
                              Sym, Type)
                ELSE
                   MetaError1('attempting to declare a type {%1ad} as itself', Sym)
@@ -2896,15 +2896,20 @@ END StartBuildArray ;
 
 PROCEDURE EndBuildArray ;
 VAR
+   typetok,
+   arraytok,
+   combinedtok: CARDINAL ;
    TypeSym,
-   ArraySym: CARDINAL ;
-BEGIN
-   PopT(TypeSym) ;
-   PopT(ArraySym) ;
-   Assert(IsArray(ArraySym)) ;
-   PutArray(ArraySym, TypeSym) ;
-   PushT(ArraySym) ;
-   Annotate("%1s(%1d)||array type")
+   ArraySym   : CARDINAL ;
+BEGIN
+   PopTtok (TypeSym, typetok) ;
+   PopTtok (ArraySym, arraytok) ;
+   Assert (IsArray (ArraySym)) ;
+   combinedtok := MakeVirtual2Tok (arraytok, typetok) ;
+   PutArray (ArraySym, TypeSym) ;
+   PutDeclared (combinedtok, ArraySym) ;
+   PushTtok (ArraySym, combinedtok) ;
+   Annotate ("%1s(%1d)||array type")
 END EndBuildArray ;
 
 
@@ -2928,15 +2933,17 @@ END EndBuildArray ;
 
 PROCEDURE BuildFieldArray ;
 VAR
+   typetok,
+   arraytok  : CARDINAL ;
    Subscript,
    Type,
    Array     : CARDINAL ;
    name      : Name ;
 BEGIN
-   PopTF(Type, name) ;
-   PopT(Array) ;
-   Assert(IsArray(Array)) ;
-   Subscript := MakeSubscript() ;
+   PopTFtok (Type, name, typetok) ;
+   PopTtok (Array, arraytok) ;
+   Assert (IsArray (Array)) ;
+   Subscript := MakeSubscript () ;
    (*
       We cannot Assert(IsSubrange(Type)) as the subrange type might be
       declared later on in the file.
@@ -2946,10 +2953,10 @@ BEGIN
       However this works to our advantage as it preserves the
       actual declaration as specified by the source file.
    *)
-   PutSubscript(Subscript, Type) ;
-   PutArraySubscript(Array, Subscript) ;
-   PushT(Array) ;
-   Annotate("%1s(%1d)||array type")
+   PutSubscript (Subscript, Type) ;
+   PutArraySubscript (Array, Subscript) ;
+   PushTtok (Array, arraytok) ;
+   Annotate ("%1s(%1d)||array type")
 (* ; WriteString('Field Placed in Array') ; WriteLn *)
 END BuildFieldArray ;
 

diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index 506444f5859e75f50960e0df1283ff87bcaab7ce..0a0ce64b401bc430210715978b927185cbcce521 100644 (file)
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -2551,10 +2551,10 @@ PROCEDURE NoOfElements (Sym: CARDINAL) : CARDINAL ;
 
 
 (*
-   PutArray - places a type symbol into an Array.
+   PutArray - places a type symbol into an arraysym.
 *)
 
-PROCEDURE PutArray (Sym, TypeSymbol: CARDINAL) ;
+PROCEDURE PutArray (arraysym, typesym: CARDINAL) ;
 
 
 (*

diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 5ef71ea9bad5c6b0a862e3d034c57c1e1f60e606..a502fb576411bb322b9ebef4db61618a19ae43f6 100644 (file)
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -12397,20 +12397,20 @@ END GetDimension ;
 
 
 (*
-   PutArray - places a type symbol into an Array.
+   PutArray - places a type symbol into an arraysym.
 *)
 
-PROCEDURE PutArray (Sym, TypeSymbol: CARDINAL) ;
+PROCEDURE PutArray (arraysym, typesym: CARDINAL) ;
 VAR
    pSym: PtrToSymbol ;
 BEGIN
-   pSym := GetPsym(Sym) ;
+   pSym := GetPsym (arraysym) ;
    WITH pSym^ DO
       CASE SymbolType OF
 
       ErrorSym: |
       ArraySym: WITH Array DO
-                   Type := TypeSymbol (* The Array Type. ARRAY OF Type.      *)
+                   Type := typesym  (* The ARRAY OF typesym.  *)
                 END
       ELSE
          InternalError ('expecting an Array symbol')

diff --git a/gcc/testsuite/gm2/iso/fail/arraymismatch.mod b/gcc/testsuite/gm2/iso/fail/arraymismatch.mod
new file mode 100644 (file)
index 0000000..543ff29
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/arraymismatch.mod
@@ -0,0 +1,8 @@
+MODULE arraymismatch ;
+
+VAR
+   a: ARRAY [0..3] OF REAL ;
+   b: ARRAY [0..4] OF REAL ;
+BEGIN
+   a := b
+END arraymismatch.