https://gcc.gnu.org/g:aa19c1076f4949c95f4eafb8fbe5a44dfb8ae11c
commit r16-2696-gaa19c1076f4949c95f4eafb8fbe5a44dfb8ae11c
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Thu Jul 31 23:28:53 2025 +0100
PR modula2/121314: quotes appearing in concatenated error strings
This patch fixes the addition of strings so that no extraneous quotes
appear in the result string. The fix is made to the bootstrap tool mc
and it has been rebuilt.
gcc/m2/ChangeLog:
PR modula2/121314
* mc-boot/GFormatStrings.cc (PerformFormatString): Rebuilt.
* mc-boot/GM2EXCEPTION.cc (M2EXCEPTION_M2Exception): Rebuilt.
* mc-boot/GSFIO.cc (SFIO_GetFileName): Rebuilt.
* mc-boot/GSFIO.h (SFIO_GetFileName): Rebuilt.
* mc-boot/Gdecl.cc: Rebuilt.
* mc-boot/GmcFileName.h: Rebuilt.
* mc/decl.mod (getStringChar): New procedure function.
(getStringContents): Call getStringChar.
(addQuotes): New procedure function.
(foldBinary): Call addQuotes to add delimiting quotes
to the new string.
gcc/testsuite/ChangeLog:
PR modula2/121314
* gm2/errors/fail/badindrtype.mod: New test.
* gm2/errors/fail/badindrtype2.mod: New test.
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/mc-boot/GFormatStrings.cc | 4 +-
gcc/m2/mc-boot/GM2EXCEPTION.cc | 6 +--
gcc/m2/mc-boot/GSFIO.cc | 20 ++++++++
gcc/m2/mc-boot/GSFIO.h | 7 +++
gcc/m2/mc-boot/Gdecl.cc | 71 ++++++++++++++++++++++++--
gcc/m2/mc-boot/GmcFileName.h | 2 +-
gcc/m2/mc/decl.mod | 47 ++++++++++++++++-
gcc/testsuite/gm2/errors/fail/badindrtype.mod | 16 ++++++
gcc/testsuite/gm2/errors/fail/badindrtype2.mod | 16 ++++++
9 files changed, 177 insertions(+), 12 deletions(-)
diff --git a/gcc/m2/mc-boot/GFormatStrings.cc b/gcc/m2/mc-boot/GFormatStrings.cc
index f4c4fd6f8c10..ad7e7d8345b4 100644
--- a/gcc/m2/mc-boot/GFormatStrings.cc
+++ b/gcc/m2/mc-boot/GFormatStrings.cc
@@ -464,7 +464,7 @@ static DynamicStrings_String PerformFormatString
(DynamicStrings_String fmt, int
/* avoid dangling else. */
afterperc += 1;
Cast ((unsigned char *) &u, (sizeof (u)-1), (const unsigned char
*) w, _w_high);
- in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt,
(*startpos), nextperc));
+ in = Copy (fmt, in, (*startpos), nextperc);
in = DynamicStrings_ConCat (in, StringConvert_CardinalToString
(u, static_cast<unsigned int> (width), leader, 16, true));
(*startpos) = afterperc;
DSdbExit (static_cast<DynamicStrings_String> (NULL));
@@ -475,7 +475,7 @@ static DynamicStrings_String PerformFormatString
(DynamicStrings_String fmt, int
/* avoid dangling else. */
afterperc += 1;
Cast ((unsigned char *) &u, (sizeof (u)-1), (const unsigned char
*) w, _w_high);
- in = DynamicStrings_ConCat (in, DynamicStrings_Slice (fmt,
(*startpos), nextperc));
+ in = Copy (fmt, in, (*startpos), nextperc);
in = DynamicStrings_ConCat (in, StringConvert_CardinalToString
(u, static_cast<unsigned int> (width), leader, 10, false));
(*startpos) = afterperc;
DSdbExit (static_cast<DynamicStrings_String> (NULL));
diff --git a/gcc/m2/mc-boot/GM2EXCEPTION.cc b/gcc/m2/mc-boot/GM2EXCEPTION.cc
index 62d47f08b5b5..6baff3c4edda 100644
--- a/gcc/m2/mc-boot/GM2EXCEPTION.cc
+++ b/gcc/m2/mc-boot/GM2EXCEPTION.cc
@@ -34,7 +34,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If
not, see
typedef struct { PROC_t proc; } PROC;
# endif
-# include "Gmcrts.h"
#define _M2EXCEPTION_C
#include "GM2EXCEPTION.h"
@@ -51,18 +50,19 @@ extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception
(void)
/* If the program or coroutine is in the exception state then return the
enumeration
value representing the exception cause. If it is not in the exception
state then
- raises and exception (exException). */
+ raises an exException exception. */
e = RTExceptions_GetExceptionBlock ();
n = RTExceptions_GetNumber (e);
if (n == (UINT_MAX))
{
RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)),
const_cast<void*> (static_cast<const
void*>("../../gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*>
(static_cast<const void*>("M2Exception")), const_cast<void*> (static_cast<const
void*>("current coroutine is not in the exceptional execution state")));
+ return M2EXCEPTION_exException;
}
else
{
return (M2EXCEPTION_M2Exceptions) (n);
}
- ReturnException ("../../gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
+ /* static analysis guarentees a RETURN statement will be used before here.
*/
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GSFIO.cc b/gcc/m2/mc-boot/GSFIO.cc
index 6ae0d5e04855..f8c13d30921d 100644
--- a/gcc/m2/mc-boot/GSFIO.cc
+++ b/gcc/m2/mc-boot/GSFIO.cc
@@ -99,6 +99,13 @@ extern "C" DynamicStrings_String SFIO_WriteS (FIO_File file,
DynamicStrings_Stri
extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file);
+/*
+ GetFileName - return a new string containing the name of the file.
+ The string should be killed by the caller.
+*/
+
+extern "C" DynamicStrings_String SFIO_GetFileName (FIO_File file);
+
/*
Exists - returns TRUE if a file named, fname exists for reading.
@@ -207,6 +214,19 @@ extern "C" DynamicStrings_String SFIO_ReadS (FIO_File file)
__builtin_unreachable ();
}
+
+/*
+ GetFileName - return a new string containing the name of the file.
+ The string should be killed by the caller.
+*/
+
+extern "C" DynamicStrings_String SFIO_GetFileName (FIO_File file)
+{
+ return DynamicStrings_InitStringCharStar (FIO_getFileName (file));
+ /* static analysis guarentees a RETURN statement will be used before here.
*/
+ __builtin_unreachable ();
+}
+
extern "C" void _M2_SFIO_init (__attribute__((unused)) int argc,
__attribute__((unused)) char *argv[], __attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/mc-boot/GSFIO.h b/gcc/m2/mc-boot/GSFIO.h
index 42ffc48782a6..93c80994a481 100644
--- a/gcc/m2/mc-boot/GSFIO.h
+++ b/gcc/m2/mc-boot/GSFIO.h
@@ -103,6 +103,13 @@ EXTERN DynamicStrings_String SFIO_WriteS (FIO_File file,
DynamicStrings_String s
*/
EXTERN DynamicStrings_String SFIO_ReadS (FIO_File file);
+
+/*
+ GetFileName - return a new string containing the name of the file.
+ The string should be killed by the caller.
+*/
+
+EXTERN DynamicStrings_String SFIO_GetFileName (FIO_File file);
# ifdef __cplusplus
}
# endif
diff --git a/gcc/m2/mc-boot/Gdecl.cc b/gcc/m2/mc-boot/Gdecl.cc
index ae0348398501..94ea098710d5 100644
--- a/gcc/m2/mc-boot/Gdecl.cc
+++ b/gcc/m2/mc-boot/Gdecl.cc
@@ -2549,6 +2549,14 @@ static bool isLeafString (decl_node__opaque n);
static DynamicStrings_String getLiteralStringContents (decl_node__opaque n);
+/*
+ getStringChar - if the string is delimited by single
+ or double quotes then strip both
+ quotes from the string.
+*/
+
+static DynamicStrings_String getStringChar (decl_node__opaque n);
+
/*
getStringContents - return the string contents of a constant, literal,
string or a constexp node.
@@ -2569,7 +2577,13 @@ static nameKey_Name addNames (decl_node__opaque a,
decl_node__opaque b);
static decl_node__opaque resolveString (decl_node__opaque n);
/*
- foldBinary -
+ addQuotes - adds delimiter quote char to string.
+*/
+
+static DynamicStrings_String addQuotes (DynamicStrings_String s, char quote);
+
+/*
+ foldBinary - attempt to fold binary + for string constants.
*/
static decl_node__opaque foldBinary (decl_nodeT k, decl_node__opaque l,
decl_node__opaque r, decl_node__opaque res);
@@ -7589,6 +7603,32 @@ static DynamicStrings_String getLiteralStringContents
(decl_node__opaque n)
}
+/*
+ getStringChar - if the string is delimited by single
+ or double quotes then strip both
+ quotes from the string.
+*/
+
+static DynamicStrings_String getStringChar (decl_node__opaque n)
+{
+ DynamicStrings_String s;
+
+ s = getString (n);
+ if (((DynamicStrings_char (s, 0)) == '\'') && ((DynamicStrings_char (s, -1))
== '\''))
+ {
+ s = DynamicStrings_Slice (s, 1, -1);
+ }
+ else if (((DynamicStrings_char (s, 0)) == '"') && ((DynamicStrings_char (s,
-1)) == '"'))
+ {
+ /* avoid dangling else. */
+ s = DynamicStrings_Slice (s, 1, -1);
+ }
+ return s;
+ /* static analysis guarentees a RETURN statement will be used before here.
*/
+ __builtin_unreachable ();
+}
+
+
/*
getStringContents - return the string contents of a constant, literal,
string or a constexp node.
@@ -7608,7 +7648,7 @@ static DynamicStrings_String getStringContents
(decl_node__opaque n)
else if (isString (n))
{
/* avoid dangling else. */
- return getString (n);
+ return getStringChar (n);
}
else if (isConstExp (n))
{
@@ -7672,11 +7712,29 @@ static decl_node__opaque resolveString
(decl_node__opaque n)
/*
- foldBinary -
+ addQuotes - adds delimiter quote char to string.
+*/
+
+static DynamicStrings_String addQuotes (DynamicStrings_String s, char quote)
+{
+ DynamicStrings_String qs;
+
+ s = DynamicStrings_ConCatChar (s, quote);
+ qs = DynamicStrings_InitStringChar (quote);
+ qs = DynamicStrings_ConCat (qs, DynamicStrings_Mark (s));
+ return qs;
+ /* static analysis guarentees a RETURN statement will be used before here.
*/
+ __builtin_unreachable ();
+}
+
+
+/*
+ foldBinary - attempt to fold binary + for string constants.
*/
static decl_node__opaque foldBinary (decl_nodeT k, decl_node__opaque l,
decl_node__opaque r, decl_node__opaque res)
{
+ char qc;
decl_node__opaque n;
DynamicStrings_String ls;
DynamicStrings_String rs;
@@ -7686,7 +7744,12 @@ static decl_node__opaque foldBinary (decl_nodeT k,
decl_node__opaque l, decl_nod
{
ls = getStringContents (l);
rs = getStringContents (r);
+ qc = '\'';
+ /* Add unquoted contents. */
ls = DynamicStrings_Add (ls, rs);
+ /* Add quote. */
+ ls = addQuotes (ls, qc);
+ /* Build new string. */
n = static_cast<decl_node__opaque> (decl_makeString (nameKey_makekey
(DynamicStrings_string (ls))));
ls = DynamicStrings_KillString (ls);
rs = DynamicStrings_KillString (rs);
@@ -22789,7 +22852,7 @@ static decl_node__opaque doDupExpr (decl_node__opaque n)
break;
case decl_length:
- M2RTS_HALT (-1);
+ M2RTS_HALT (-1); /* length should have been converted into unary. */
__builtin_unreachable ();
break;
diff --git a/gcc/m2/mc-boot/GmcFileName.h b/gcc/m2/mc-boot/GmcFileName.h
index 11f1512dbe81..6c7ec758ef42 100644
--- a/gcc/m2/mc-boot/GmcFileName.h
+++ b/gcc/m2/mc-boot/GmcFileName.h
@@ -50,7 +50,7 @@ extern "C" {
given a module and an extension. This file name
length will be operating system specific.
String, Extension, is concatenated onto
- Module and thus it is safe to `Mark' the extension
+ Module and thus it is safe to Mark the extension
for garbage collection.
*/
diff --git a/gcc/m2/mc/decl.mod b/gcc/m2/mc/decl.mod
index 342487e398db..197ca5e568ab 100644
--- a/gcc/m2/mc/decl.mod
+++ b/gcc/m2/mc/decl.mod
@@ -4642,6 +4642,28 @@ BEGIN
END getLiteralStringContents ;
+(*
+ getStringChar - if the string is delimited by single
+ or double quotes then strip both
+ quotes from the string.
+*)
+
+PROCEDURE getStringChar (n: node) : String ;
+VAR
+ s: String ;
+BEGIN
+ s := getString (n) ;
+ IF (DynamicStrings.char (s, 0) = "'") AND (DynamicStrings.char (s, -1) =
"'")
+ THEN
+ s := DynamicStrings.Slice (s, 1, -1)
+ ELSIF (DynamicStrings.char (s, 0) = '"') AND (DynamicStrings.char (s, -1) =
'"')
+ THEN
+ s := DynamicStrings.Slice (s, 1, -1)
+ END ;
+ RETURN s
+END getStringChar ;
+
+
(*
getStringContents - return the string contents of a constant, literal,
string or a constexp node.
@@ -4657,7 +4679,7 @@ BEGIN
RETURN getLiteralStringContents (n)
ELSIF isString (n)
THEN
- RETURN getString (n)
+ RETURN getStringChar (n)
ELSIF isConstExp (n)
THEN
RETURN getStringContents (n^.unaryF.arg)
@@ -4709,11 +4731,27 @@ END resolveString ;
(*
- foldBinary -
+ addQuotes - adds delimiter quote char to string.
+*)
+
+PROCEDURE addQuotes (s: String; quote: CHAR) : String ;
+VAR
+ qs: String ;
+BEGIN
+ s := DynamicStrings.ConCatChar (s, quote) ;
+ qs := DynamicStrings.InitStringChar (quote) ;
+ qs := DynamicStrings.ConCat (qs, DynamicStrings.Mark (s)) ;
+ RETURN qs
+END addQuotes ;
+
+
+(*
+ foldBinary - attempt to fold binary + for string constants.
*)
PROCEDURE foldBinary (k: nodeT; l, r: node; res: node) : node ;
VAR
+ qc: CHAR ;
n : node ;
ls,
rs: String ;
@@ -4723,7 +4761,12 @@ BEGIN
THEN
ls := getStringContents (l) ;
rs := getStringContents (r) ;
+ qc := "'" ;
+ (* Add unquoted contents. *)
ls := DynamicStrings.Add (ls, rs) ;
+ (* Add quote. *)
+ ls := addQuotes (ls, qc) ;
+ (* Build new string. *)
n := makeString (makekey (DynamicStrings.string (ls))) ;
ls := DynamicStrings.KillString (ls) ;
rs := DynamicStrings.KillString (rs)
diff --git a/gcc/testsuite/gm2/errors/fail/badindrtype.mod
b/gcc/testsuite/gm2/errors/fail/badindrtype.mod
new file mode 100644
index 000000000000..b39302751ed6
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badindrtype.mod
@@ -0,0 +1,16 @@
+MODULE badindrtype ;
+
+
+PROCEDURE init (VAR ch: CHAR) ;
+VAR
+ c: CARDINAL ;
+BEGIN
+ ch := c
+END init ;
+
+
+VAR
+ ch: CHAR ;
+BEGIN
+ init (ch)
+END badindrtype.
diff --git a/gcc/testsuite/gm2/errors/fail/badindrtype2.mod
b/gcc/testsuite/gm2/errors/fail/badindrtype2.mod
new file mode 100644
index 000000000000..a31303bcc935
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badindrtype2.mod
@@ -0,0 +1,16 @@
+MODULE badindrtype2 ;
+
+
+PROCEDURE init (VAR ch: CHAR) ;
+VAR
+ c: CARDINAL ;
+BEGIN
+ c := ch
+END init ;
+
+
+VAR
+ ch: CHAR ;
+BEGIN
+ init (ch)
+END badindrtype2.
