Merge branch 'master' into gfortran-testdevel/gfortran-test

6 files changed, 65 insertions, 34 deletions

diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 4a9ced3..2440b2a 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -2903,9 +2903,6 @@ END CheckStop ;
 *)
 
 PROCEDURE FoldBecomes (p: WalkAction; bb: BasicBlock; quad: CARDINAL) ;
-VAR
-   op            : QuadOperator ;
-   des, op2, expr: CARDINAL ;
 BEGIN
    IF DeclaredOperandsBecomes (p, quad)
    THEN
@@ -6442,37 +6439,52 @@ END ResolveHigh ;
 
 
 (*
+   IsUnboundedArray - return TRUE if symbol is an unbounded array.
+*)
+
+PROCEDURE IsUnboundedArray (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   IF IsParameter (sym) OR IsVar (sym)
+   THEN
+      RETURN IsUnbounded (GetType (sym))
+   END ;
+   RETURN FALSE
+END IsUnboundedArray ;
+
+
+(*
    FoldHigh - if the array is not dynamic then we should be able to
               remove the HighOp quadruple and assign op1 with
-              the known compile time HIGH(op3).
+              the known compile time HIGH(array).
 *)
 
 PROCEDURE FoldHigh (tokenno: CARDINAL; p: WalkAction;
-                    quad: CARDINAL; op1, dim, op3: CARDINAL) ;
+                    quad: CARDINAL; op1, dim, array: CARDINAL) ;
 VAR
    t       : tree ;
    location: location_t ;
 BEGIN
-   (* firstly ensure that any constant literal is declared *)
-   TryDeclareConstant(tokenno, op3) ;
-   location := TokenToLocation(tokenno) ;
-   IF GccKnowsAbout(op3) AND CompletelyResolved(op3)
+   (* Firstly ensure that any constant literal is declared.  *)
+   TryDeclareConstant (tokenno, array) ;
+   location := TokenToLocation (tokenno) ;
+   IF (NOT IsUnboundedArray (array)) AND
+      GccKnowsAbout (array) AND CompletelyResolved (array)
    THEN
-      t := ResolveHigh(tokenno, dim, op3) ;
-      (* fine, we can take advantage of this and fold constants *)
-      IF IsConst(op1) AND (t#tree(NIL))
+      t := ResolveHigh (tokenno, dim, array) ;
+      (* We can take advantage of this and fold constants.  *)
+      IF IsConst (op1) AND (t # tree (NIL))
       THEN
-         PutConst(op1, Cardinal) ;
-         AddModGcc(op1,
-                   DeclareKnownConstant(location, GetCardinalType(),
-                                        ToCardinal(location, t))) ;
-         p(op1) ;
+         PutConst (op1, Cardinal) ;
+         AddModGcc (op1,
+                    DeclareKnownConstant (location, GetCardinalType (),
+                                          ToCardinal (location, t))) ;
+         p (op1) ;
          NoChange := FALSE ;
-         SubQuad(quad)
+         SubQuad (quad)
       ELSE
-         (* we can still fold the expression, but not the assignment, however, we will
-            not do this here but in CodeHigh
-         *)
+         (* We can still fold the expression but not the assignment,
+            we will not do this here but in CodeHigh when the result
+            can be stored.  *)
       END
    END
 END FoldHigh ;
@@ -8154,8 +8166,6 @@ VAR
    rightpos,
    typepos,
    indrxpos        : CARDINAL ;
-   length,
-   newstr          : tree ;
    location        : location_t ;
 BEGIN
    GetQuadOtok (quad, indrxpos, op, left, type, right,
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
index dcac2ba..f1516d3 100644
--- a/gcc/m2/gm2-compiler/M2Range.mod
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -1869,14 +1869,12 @@ END FoldTypeAssign ;
 
 PROCEDURE FoldTypeIndrX (q: CARDINAL; tokenNo: CARDINAL; des, expr: CARDINAL; r: CARDINAL) ;
 VAR
-   desType,
    exprType: CARDINAL ;
 BEGIN
    (* Need to skip over a variable or temporary in des and expr so
       long as expr is not a procedure.  In the case of des = *expr,
       both expr and des will be variables due to the property of
       indirection.  *)
-   desType := GetType (des) ;
    IF IsProcedure (expr)
    THEN
       (* Must not GetType for a procedure as it gives the return type.  *)
diff --git a/gcc/m2/gm2-compiler/M2Students.def b/gcc/m2/gm2-compiler/M2Students.def
index 7d67a0a..a3ecdcd 100644
--- a/gcc/m2/gm2-compiler/M2Students.def
+++ b/gcc/m2/gm2-compiler/M2Students.def
@@ -39,7 +39,7 @@ EXPORT QUALIFIED StudentVariableCheck, CheckVariableAgainstKeyword ;
                                  as a keyword except for its case.
 *)
 
-PROCEDURE CheckVariableAgainstKeyword (name: Name) ;
+PROCEDURE CheckVariableAgainstKeyword (tok: CARDINAL; name: Name) ;
 
 
 (*
diff --git a/gcc/m2/gm2-compiler/M2Students.mod b/gcc/m2/gm2-compiler/M2Students.mod
index e539eb0..3df160a 100644
--- a/gcc/m2/gm2-compiler/M2Students.mod
+++ b/gcc/m2/gm2-compiler/M2Students.mod
@@ -25,7 +25,7 @@ IMPLEMENTATION MODULE M2Students ;
 FROM SymbolTable IMPORT FinalSymbol, IsVar, IsProcedure, IsModule,
                         GetMainModule, IsType, NulSym, IsRecord, GetSymName, GetNth, GetNthProcedure, GetDeclaredMod, NoOfParam ;
 FROM NameKey IMPORT GetKey, WriteKey, MakeKey, IsSameExcludingCase, NulName, makekey, KeyToCharStar ;
-FROM M2MetaError IMPORT MetaErrorString0, MetaError2 ;
+FROM M2MetaError IMPORT MetaErrorStringT0, MetaError2 ;
 FROM Lists IMPORT List, InitList, IsItemInList, IncludeItemIntoList ;
 FROM M2Reserved IMPORT IsReserved, toktype ;
 FROM DynamicStrings IMPORT String, InitString, KillString, ToUpper, InitStringCharStar, string, Mark, ToUpper, Dup ;
@@ -78,11 +78,11 @@ END IsNotADuplicateName ;
                                  as a keyword except for its case.
 *)
 
-PROCEDURE CheckVariableAgainstKeyword (name: Name) ;
+PROCEDURE CheckVariableAgainstKeyword (tok: CARDINAL; name: Name) ;
 BEGIN
    IF StyleChecking
    THEN
-      PerformVariableKeywordCheck (name)
+      PerformVariableKeywordCheck (tok, name)
    END
 END CheckVariableAgainstKeyword ;
 
@@ -91,7 +91,7 @@ END CheckVariableAgainstKeyword ;
    PerformVariableKeywordCheck - performs the check and constructs the metaerror notes if appropriate.
 *)
 
-PROCEDURE PerformVariableKeywordCheck (name: Name) ;
+PROCEDURE PerformVariableKeywordCheck (tok: CARDINAL; name: Name) ;
 VAR
    upper : Name ;
    token : toktype ;
@@ -105,9 +105,11 @@ BEGIN
    THEN
       IF IsNotADuplicateName (name)
       THEN
-         MetaErrorString0 (Sprintf2 (Mark (InitString ('either the identifier has the same name as a keyword or alternatively a keyword has the wrong case ({%%K%s} and {!%%O:{%%K%s}})')),
-                                     upperS, orig)) ;
-         MetaErrorString0 (Sprintf1 (Mark (InitString ('the symbol name {!%%O:{%%K%s}} is legal as an identifier, however as such it might cause confusion and is considered bad programming practice')), orig))
+         MetaErrorStringT0 (tok,
+                            Sprintf2 (Mark (InitString ('either the identifier has the same name as a keyword or alternatively a keyword has the wrong case ({%%K%s} and {!%%O:{%%K%s}})')),
+                                      upperS, orig)) ;
+         MetaErrorStringT0 (tok,
+                            Sprintf1 (Mark (InitString ('the symbol name {!%%O:{%%K%s}} is legal as an identifier, however as such it might cause confusion and is considered bad programming practice')), orig))
       END
    END ;
    upperS := KillString (upperS) ;
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod
index 3bb3e47..54e624f 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -1179,8 +1179,8 @@ BEGIN
    PopT (n) ;
    i := 1 ;
    WHILE i <= n DO
-      CheckVariableAgainstKeyword (OperandT (n+1-i)) ;
       tok := OperandTok (n+1-i) ;
+      CheckVariableAgainstKeyword (tok, OperandT (n+1-i)) ;
       Var := MakeVar (tok, OperandT (n+1-i)) ;
       AtAddress := OperandA (n+1-i) ;
       IF AtAddress # NulSym
diff --git a/gcc/m2/gm2-compiler/PathName.mod b/gcc/m2/gm2-compiler/PathName.mod
index 6fc7612..0ba9024 100644
--- a/gcc/m2/gm2-compiler/PathName.mod
+++ b/gcc/m2/gm2-compiler/PathName.mod
@@ -1,3 +1,24 @@
+(* M2PathName.mod maintain a dictionary of named paths.
+
+Copyright (C) 2023-2025 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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, or (at your option)
+any later version.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  *)
+
 IMPLEMENTATION MODULE PathName ;
 
 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;