[gcc r13-7640] PR modula2/109952 Inconsistent HIGH values with 'ARRAY OF CHAR'

[gcc r13-7640] PR modula2/109952 Inconsistent HIGH values with 'ARRAY OF CHAR'

[Gaius Mulley]

https://gcc.gnu.org/g:6ae50730003862aee81ad6c53e4c1a96ed1ee36e

commit r13-7640-g6ae50730003862aee81ad6c53e4c1a96ed1ee36e
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date:   Sat Jul 29 04:13:34 2023 +0100

    PR modula2/109952 Inconsistent HIGH values with 'ARRAY OF CHAR'
    
    This patch fixes the case when a single character constant literal is
    passed as a string actual parameter to an ARRAY OF CHAR formal parameter.
    To be consistent a single character is promoted to a string and nul
    terminated (and its high value is 1).  Previously a single character
    string would not be nul terminated and the high value was 0.
    The documentation now includes a section describing the expected behavior
    and included in this patch is some regression test code matching the
    table inside the documentation.
    
    gcc/ChangeLog:
    
            PR modula2/109952
            * doc/gm2.texi (High procedure function): New node.
            (Using): New menu entry for High procedure function.
    
    gcc/m2/ChangeLog:
    
            PR modula2/109952
            * Make-maintainer.in: Change header to include emacs file mode.
            * gm2-compiler/M2GenGCC.mod (BuildHighFromChar): Check whether
            operand is a constant string and is nul terminated then return one.
            * gm2-compiler/PCSymBuild.mod (WalkFunction): Add default return
            TRUE.  Static analysis missing return path fix.
            * gm2-libs/IO.mod (Init): Rewrite to help static analysis.
            * target-independent/m2/gm2-libs.texi: Rebuild.
    
    gcc/testsuite/ChangeLog:
    
            PR modula2/109952
            * gm2/pim/run/pass/hightests.mod: New test.
    
    (cherry picked from commit b4df098647b687ca4e43952ec4a198b2816732ba)
    
    Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

Diff:
---
 gcc/doc/gm2.texi                             | 97 +++++++++++++++++++++++++++-
 gcc/m2/Make-maintainer.in                    |  2 +-
 gcc/m2/gm2-compiler/M2GenGCC.mod             |  8 ++-
 gcc/m2/gm2-compiler/PCSymBuild.mod           |  3 +-
 gcc/m2/gm2-libs/IO.mod                       | 16 ++---
 gcc/m2/target-independent/m2/gm2-libs.texi   | 78 ++++++++++++----------
 gcc/testsuite/gm2/pim/run/pass/hightests.mod | 61 +++++++++++++++++
 7 files changed, 216 insertions(+), 49 deletions(-)

diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi
index db35f6f7e93..ae2f8fc830a 100644
--- a/gcc/doc/gm2.texi
+++ b/gcc/doc/gm2.texi
@@ -227,6 +227,7 @@ such as the AVR and the ARM).
 * Linking::               Linking options in more detail.
 * Elementary data types:: Data types supported by GNU Modula-2.
 * Standard procedures::   Permanently accessible base procedures.
+* High procedure function:: Behavior of the high procedure function.
 * Dialect::               GNU Modula-2 supported dialects.
 * Exceptions::            Exception implementation
 * Semantic checking::     How to detect run time problems at compile time.
@@ -986,7 +987,7 @@ PROCEDURE HALT ;
              foo('hello')
           END
 
-          will cause the local variable c to contain the value 4
+          will cause the local variable c to contain the value 5
 *)
 
 @findex HIGH
@@ -1228,7 +1229,99 @@ PROCEDURE ODD (v: <any whole number type>) : BOOLEAN ;
 PROCEDURE RE (c: <any complex type>) : <floating point type> ;
 @end example
 
-@node Dialect, Exceptions, Standard procedures, Using
+@node High procedure function, Dialect, Standard procedures, Using
+
+@section Behavior of the high procedure function
+
+This section describes the behavior of the standard procedure function
+@code{HIGH} and it includes a table of parameters with the expected
+return result.  The standard procedure function will return the last
+accessible indice of an @code{ARRAY}.  If the parameter to @code{HIGH}
+is a static array then the result will be a @code{CARDINAL} value
+matching the upper bound in the @code{ARRAY} declaration.
+
+The section also describes the behavior of a string literal actual
+parameter and how it relates to @code{HIGH}.
+The PIM2, PIM3, PIM4 and ISO standard is silent on the issue of
+whether a @code{nul} is present in an @code{ARRAY} @code{OF}
+@code{CHAR} actual parameter.
+
+If the first parameter to @code{HIGH} is an unbounded @code{ARRAY} the
+return value from @code{HIGH} will be the last accessible element in
+the array.  If a constant string literal is passed as an actual
+parameter then it will be @code{nul} terminated.  The table and
+example code below describe the effect of passing an actual parameter
+and the expected @code{HIGH} value.
+
+@example
+MODULE example1 ;
+
+PROCEDURE test (a: ARRAY OF CHAR) ;
+VAR
+   x: CARDINAL ;
+BEGIN
+   x := HIGH (a) ;
+   ...
+END test ;
+
+
+BEGIN
+   test ('') ;
+   test ('1') ;
+   test ('12') ;
+   test ('123') ;
+END example1.
+
+
+Actual parameter | HIGH (a) | a[HIGH (a)] = nul
+===============================================
+ ''              | 0        | TRUE
+ '1'             | 1        | TRUE
+ '12'            | 2        | TRUE
+ '123'           | 3        | TRUE
+@end example
+
+A constant string literal will be passed to an @code{ARRAY} @code{OF}
+@code{CHAR} with an appended @code{nul} @code{CHAR}.  Thus if the
+constant string literal @code{''} is passed as an actual parameter (in
+example1) then the result from @code{HIGH(a)} will be @code{0}.
+
+@example
+MODULE example2 ;
+
+PROCEDURE test (a: ARRAY OF CHAR) ;
+VAR
+   x: CARDINAL ;
+BEGIN
+   x := HIGH (a) ;
+   ...
+END test ;
+
+VAR
+   str0: ARRAY [0..0] OF CHAR ;
+   str1: ARRAY [0..1] OF CHAR ;
+   str2: ARRAY [0..2] OF CHAR ;
+   str3: ARRAY [0..3] OF CHAR ;
+BEGIN
+   str0 := 'a' ;   (* No room for the nul terminator.  *)
+   test (str0) ;
+   str1 := 'ab' ;  (* No room for the nul terminator.  *)
+   test (str1) ;
+   str2 := 'ab' ;  (* Terminated with a nul.  *)
+   test (str2) ;
+   str2 := 'abc' ; (* Terminated with a nul.  *)
+   test (str3) ;
+END example2.
+
+Actual parameter | HIGH (a) | a[HIGH (a)] = nul
+===============================================
+ str0            | 0        | FALSE
+ str1            | 1        | FALSE
+ atr2            | 2        | TRUE
+ str3            | 3        | TRUE
+@end example
+
+@node Dialect, Exceptions, High procedure function, Using
 @section GNU Modula-2 supported dialects
 
 This section describes the dialects understood by GNU Modula-2.
diff --git a/gcc/m2/Make-maintainer.in b/gcc/m2/Make-maintainer.in
index 67816076653..36a2f0fb8e8 100644
--- a/gcc/m2/Make-maintainer.in
+++ b/gcc/m2/Make-maintainer.in
@@ -1,4 +1,4 @@
-# Make-maintainer.in build support tools for GNU M2.
+# Make-maintainer.in subsidiary -*- makefile -*- build support for GNU M2 tools.
 
 # Copyright (C) 2022-2023 Free Software Foundation, Inc.
 
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 9e975ba735d..67a003e3dd6 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -41,6 +41,7 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
                         NoOfParam, GetParent, GetDimension, IsAModula2Type,
                         IsModule, IsDefImp, IsType, IsModuleWithinProcedure,
                         IsConstString, GetString, GetStringLength,
+                        IsConstStringCnul, IsConstStringM2nul,
                         IsConst, IsConstSet, IsProcedure, IsProcType,
                         IsVar, IsVarParam, IsTemporary,
                         IsEnumeration,
@@ -5500,7 +5501,12 @@ VAR
    location: location_t ;
 BEGIN
    location := TokenToLocation(GetDeclaredMod(operand)) ;
-   RETURN( GetCardinalZero(location) )
+   IF IsConstString (operand) AND
+      (IsConstStringM2nul (operand) OR IsConstStringCnul (operand))
+   THEN
+      RETURN GetCardinalOne (location)
+   END ;
+   RETURN GetCardinalZero (location)
 END BuildHighFromChar ;
 
 
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod b/gcc/m2/gm2-compiler/PCSymBuild.mod
index 59b1652baab..c6708d52231 100644
--- a/gcc/m2/gm2-compiler/PCSymBuild.mod
+++ b/gcc/m2/gm2-compiler/PCSymBuild.mod
@@ -1838,7 +1838,8 @@ BEGIN
          ELSE
             MetaError1('not expecting this function inside a constant expression {%1Dad}', func)
          END
-      END
+      END ;
+      RETURN( TRUE )
    END
 END WalkFunction ;
 
diff --git a/gcc/m2/gm2-libs/IO.mod b/gcc/m2/gm2-libs/IO.mod
index c47ce3125ad..bd6d539634a 100644
--- a/gcc/m2/gm2-libs/IO.mod
+++ b/gcc/m2/gm2-libs/IO.mod
@@ -344,18 +344,12 @@ END EchoOff ;
 *)
 
 PROCEDURE Init ;
+VAR
+   fdi: CARDINAL ;
 BEGIN
-   WITH fdState[0] DO
-      IsEof := FALSE ;
-      IsRaw := FALSE
-   END ;
-   WITH fdState[1] DO
-      IsEof := FALSE ;
-      IsRaw := FALSE
-   END ;
-   WITH fdState[2] DO
-      IsEof := FALSE ;
-      IsRaw := FALSE
+   FOR fdi := 0 TO HIGH (fdState) DO
+      fdState[fdi].IsEof := FALSE ;
+      fdState[fdi].IsRaw := FALSE
    END
 END Init ;
 
diff --git a/gcc/m2/target-independent/m2/gm2-libs.texi b/gcc/m2/target-independent/m2/gm2-libs.texi
index 4af9d123968..77f9cde07ab 100644
--- a/gcc/m2/target-independent/m2/gm2-libs.texi
+++ b/gcc/m2/target-independent/m2/gm2-libs.texi
@@ -55,7 +55,6 @@ building the GNU Modula-2 compiler.
 * gm2-libs/LegacyReal::LegacyReal.def
 * gm2-libs/M2Dependent::M2Dependent.def
 * gm2-libs/M2EXCEPTION::M2EXCEPTION.def
-* gm2-libs/M2LINK::M2LINK.def
 * gm2-libs/M2RTS::M2RTS.def
 * gm2-libs/MathLib0::MathLib0.def
 * gm2-libs/MemUtils::MemUtils.def
@@ -1944,7 +1943,8 @@ TYPE
 
 
 @findex ConstructModules
-PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname,
+                            overrideliborder: ADDRESS;
                             argc: INTEGER; argv, envp: ADDRESS) ;
 
 @findex DeconstructModules
@@ -1979,7 +1979,7 @@ END M2Dependent.
 @end example
 @page
 
-@node gm2-libs/M2EXCEPTION, gm2-libs/M2LINK, gm2-libs/M2Dependent, Base libraries
+@node gm2-libs/M2EXCEPTION, gm2-libs/M2RTS, gm2-libs/M2Dependent, Base libraries
 @subsection gm2-libs/M2EXCEPTION
 
 @example
@@ -2017,33 +2017,7 @@ END M2EXCEPTION.
 @end example
 @page
 
-@node gm2-libs/M2LINK, gm2-libs/M2RTS, gm2-libs/M2EXCEPTION, Base libraries
-@subsection gm2-libs/M2LINK
-
-@example
-DEFINITION MODULE FOR "C" M2LINK ;
-
-
-TYPE
-@findex PtrToChar (type)
-   PtrToChar = POINTER TO CHAR ;
-
-(* These variables are set by the compiler in the program module
-   according to linking command line options.  *)
-
-VAR
-@findex ForcedModuleInitOrder (var)
-   ForcedModuleInitOrder: PtrToChar ;
-@findex StaticInitialization (var)
-   StaticInitialization : BOOLEAN ;
-
-
-@findex END M2LINK. (var)
-END M2LINK.
-@end example
-@page
-
-@node gm2-libs/M2RTS, gm2-libs/MathLib0, gm2-libs/M2LINK, Base libraries
+@node gm2-libs/M2RTS, gm2-libs/MathLib0, gm2-libs/M2EXCEPTION, Base libraries
 @subsection gm2-libs/M2RTS
 
 @example
@@ -2058,7 +2032,8 @@ TYPE
 
 
 @findex ConstructModules
-PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname,
+                            overrideliborder: ADDRESS;
                             argc: INTEGER; argv, envp: ADDRESS) ;
 
 @findex DeconstructModules
@@ -8956,6 +8931,7 @@ coexist with their PIM counterparts.
 * gm2-libs-iso/TERMINATION::TERMINATION.def
 * gm2-libs-iso/TermFile::TermFile.def
 * gm2-libs-iso/TextIO::TextIO.def
+* gm2-libs-iso/TextUtil::TextUtil.def
 * gm2-libs-iso/WholeConv::WholeConv.def
 * gm2-libs-iso/WholeIO::WholeIO.def
 * gm2-libs-iso/WholeStr::WholeStr.def
@@ -10830,6 +10806,7 @@ TYPE
 
 @findex ConstructModules
 PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
+                            overrideliborder: ADDRESS;
                             argc: INTEGER; argv, envp: ADDRESS) ;
 
 @findex DeconstructModules
@@ -14344,7 +14321,7 @@ END TermFile.
 @end example
 @page
 
-@node gm2-libs-iso/TextIO, gm2-libs-iso/WholeConv, gm2-libs-iso/TermFile, M2 ISO Libraries
+@node gm2-libs-iso/TextIO, gm2-libs-iso/TextUtil, gm2-libs-iso/TermFile, M2 ISO Libraries
 @subsection gm2-libs-iso/TextIO
 
 @example
@@ -14422,7 +14399,42 @@ END TextIO.
 @end example
 @page
 
-@node gm2-libs-iso/WholeConv, gm2-libs-iso/WholeIO, gm2-libs-iso/TextIO, M2 ISO Libraries
+@node gm2-libs-iso/TextUtil, gm2-libs-iso/WholeConv, gm2-libs-iso/TextIO, M2 ISO Libraries
+@subsection gm2-libs-iso/TextUtil
+
+@example
+DEFINITION MODULE TextUtil ;
+
+(*
+    Description: provides text manmipulation routines.
+*)
+
+IMPORT IOChan ;
+
+
+(*
+   SkipSpaces - skips any spaces.
+*)
+
+@findex SkipSpaces
+PROCEDURE SkipSpaces (cid: IOChan.ChanId) ;
+
+
+(* The following procedures do not read past line marks.  *)
+
+@findex CharAvailable
+PROCEDURE CharAvailable (cid: IOChan.ChanId) : BOOLEAN ;
+
+
+@findex EofOrEoln
+PROCEDURE EofOrEoln (cid: IOChan.ChanId) : BOOLEAN ;
+
+
+END TextUtil.
+@end example
+@page
+
+@node gm2-libs-iso/WholeConv, gm2-libs-iso/WholeIO, gm2-libs-iso/TextUtil, M2 ISO Libraries
 @subsection gm2-libs-iso/WholeConv
 
 @example
diff --git a/gcc/testsuite/gm2/pim/run/pass/hightests.mod b/gcc/testsuite/gm2/pim/run/pass/hightests.mod
new file mode 100644
index 00000000000..5a3eb805d45
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/run/pass/hightests.mod
@@ -0,0 +1,61 @@
+MODULE hightests ;
+
+
+FROM libc IMPORT printf, exit ;
+FROM StrLib IMPORT StrCopy ;
+
+PROCEDURE testhigh (a: ARRAY OF CHAR; expected: CARDINAL; first: CHAR; checkNul: BOOLEAN) ;
+VAR
+   copy: ARRAY [0..10] OF CHAR ;
+BEGIN
+   StrCopy (a, copy) ;
+   IF HIGH (a) # expected
+   THEN
+      printf ("unexpected high value, HIGH(%s) should be %d but was passed %d\n",
+              copy, expected, HIGH (a)) ;
+      code := 1
+   END ;
+   IF a[0] # first
+   THEN
+      printf ("unexpected first value in open array, %s, a[0] should be %c but was passed %c\n",
+              a, first, a[0]) ;
+      code := 2
+   END ;
+   IF checkNul AND (a[HIGH(a)] # 0C)
+   THEN
+      printf ("expected the array to contain a 0C terminator\n") ;
+      code := 3
+   END
+END testhigh ;
+
+
+VAR
+   str0: ARRAY [0..0] OF CHAR ;
+   str1: ARRAY [0..1] OF CHAR ;
+   str2: ARRAY [0..2] OF CHAR ;
+   str3: ARRAY [0..3] OF CHAR ;
+   ch  : CHAR ;
+   code: INTEGER ;
+BEGIN
+   testhigh ('1', 1, '1', TRUE) ;
+   str0 := '_' ;
+   str1 := '_1' ;
+   str2 := '_2' ;
+   str3 := '_3' ;
+   code := 0 ;
+   testhigh ('', 0, 0C, TRUE) ;
+   testhigh ('1', 1, '1', TRUE) ;
+   testhigh ('12', 2, '1', TRUE) ;
+   testhigh ('123', 3, '1', TRUE) ;
+   testhigh ('1234', 4, '1', TRUE) ;
+   testhigh (str0, 0, '_', FALSE) ;
+   testhigh (str1, 1, '_', FALSE) ;
+   testhigh (str2, 2, '_', TRUE) ;
+   testhigh (str3, 3, '_', TRUE) ;
+   IF code = 0
+   THEN
+      printf ("all tests pass\n")
+   ELSE
+      exit (1)
+   END
+END hightests.