From: Gaius Mulley Date: Wed, 24 May 2023 10:14:07 +0000 (+0100) Subject: PR modula2/109952 Inconsistent HIGH values with 'ARRAY OF CHAR' X-Git-Tag: basepoints/gcc-15~8981 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b4df098647b687ca4e43952ec4a198b2816732ba;p=thirdparty%2Fgcc.git 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. Signed-off-by: Gaius Mulley --- diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi index db35f6f7e931..ae2f8fc830ad 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: ) : BOOLEAN ; PROCEDURE RE (c: ) : ; @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 51b35280aa4e..363e6ed24ae5 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 9e975ba735d3..67a003e3dd6f 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 59b1652baabe..c6708d522316 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 c47ce3125ade..bd6d539634a0 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 4af9d123968b..77f9cde07abf 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 000000000000..5a3eb805d453 --- /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.