https://gcc.gnu.org/g:04799f03e8d01b903295ef3a100a0117b7ddbf5e
commit r14-9709-g04799f03e8d01b903295ef3a100a0117b7ddbf5e
Author: Gaius Mulley <(no_default)>
Date: Thu Mar 28 14:57:49 2024 +0000
PR modula2/114517 gm2 does not allow comparison operator hash in column one
This patch allows -fno-cpp to be supplied to gm2. Without this patch
it causes an ICE. The patch allows -fno-cpp to turn off cpp flags.
These are tested in m2.flex to decide whether a change of state is
allowed (enabling handling of #line directives).
gcc/ChangeLog:
PR modula2/114517
* doc/gm2.texi: Mention gm2 treats a # in the first column
as a preprocessor directive unless -fno-cpp is supplied.
gcc/m2/ChangeLog:
PR modula2/114517
* gm2-compiler/M2Options.def (SetCpp): Add comment.
(GetCpp): Move after SetCpp.
(GetLineDirectives): New procedure function.
* gm2-compiler/M2Options.mod (GetLineDirectives): New
procedure function.
* gm2-gcc/m2options.h (M2Options_GetLineDirectives): New
prototype.
* gm2-lang.cc (gm2_langhook_init_options): OPT_fcpp only
assert if !value.
* m2.flex: Test GetLineDirectives before changing to LINE0
state.
gcc/testsuite/ChangeLog:
PR modula2/114517
* gm2/cpp/fail/hashfirstcolumn2.mod: New test.
* gm2/imports/fail/imports-fail.exp: New test.
* gm2/imports/fail/localmodule2.mod: New test.
* gm2/imports/run/pass/localmodule.mod: New test.
Signed-off-by: Gaius Mulley <(no_default)>
Diff:
---
gcc/doc/gm2.texi | 3 +-
gcc/m2/gm2-compiler/M2Options.def | 36 +++++++++++++---------
gcc/m2/gm2-compiler/M2Options.mod | 10 ++++++
gcc/m2/gm2-gcc/m2options.h | 1 +
gcc/m2/gm2-lang.cc | 3 +-
gcc/m2/m2.flex | 10 ++++--
gcc/testsuite/gm2/cpp/fail/hashfirstcolumn2.mod | 18 +++++++++++
gcc/testsuite/gm2/imports/fail/imports-fail.exp | 36 ++++++++++++++++++++++
gcc/testsuite/gm2/imports/fail/localmodule2.mod | 27 ++++++++++++++++
gcc/testsuite/gm2/imports/run/pass/localmodule.mod | 27 ++++++++++++++++
10 files changed, 153 insertions(+), 18 deletions(-)
diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi
index 028a0715f64..9f6d4140e42 100644
--- a/gcc/doc/gm2.texi
+++ b/gcc/doc/gm2.texi
@@ -1657,7 +1657,8 @@ The preprocessor @samp{cpp} can be invoked via the
@samp{-fcpp}
command line option. This in turn invokes @samp{cpp} with the
following arguments @samp{-traditional -lang-asm}. These options
preserve comments and all quotations. @samp{gm2} treats a @samp{#}
-character in the first column as a preprocessor directive.
+character in the first column as a preprocessor directive unless
+@samp{-fno-cpp} is supplied.
For example here is a module which calls @code{FatalError}
via the macro @code{ERROR}.
diff --git a/gcc/m2/gm2-compiler/M2Options.def
b/gcc/m2/gm2-compiler/M2Options.def
index 90b5178f88a..e4ebf41802f 100644
--- a/gcc/m2/gm2-compiler/M2Options.def
+++ b/gcc/m2/gm2-compiler/M2Options.def
@@ -328,6 +328,28 @@ PROCEDURE SetObj (arg: ADDRESS) ;
PROCEDURE GetObj () : ADDRESS ;
+(*
+ SetCpp - enables the source to be preprocessed and enables the
+ recognition of C preprocessor line directives.
+*)
+
+PROCEDURE SetCpp (value: BOOLEAN) : BOOLEAN ;
+
+
+(*
+ GetCpp - returns TRUE if the C preprocessor was used.
+*)
+
+PROCEDURE GetCpp () : BOOLEAN ;
+
+
+(*
+ GetLineDirectives - returns TRUE if line directives are allowed.
+*)
+
+PROCEDURE GetLineDirectives () : BOOLEAN ;
+
+
(*
SetScaffoldDynamic - set the -fscaffold-dynamic flag.
*)
@@ -467,20 +489,6 @@ PROCEDURE SetQuiet (value: BOOLEAN) : BOOLEAN ;
PROCEDURE SetCC1Quiet (value: BOOLEAN) ;
-(*
- SetCpp -
-*)
-
-PROCEDURE SetCpp (value: BOOLEAN) : BOOLEAN ;
-
-
-(*
- GetCpp - returns TRUE if the C preprocessor was used.
-*)
-
-PROCEDURE GetCpp () : BOOLEAN ;
-
-
(*
SetM2g - set the -fm2-g flag.
*)
diff --git a/gcc/m2/gm2-compiler/M2Options.mod
b/gcc/m2/gm2-compiler/M2Options.mod
index 30203158e5c..b0de8cdfe82 100644
--- a/gcc/m2/gm2-compiler/M2Options.mod
+++ b/gcc/m2/gm2-compiler/M2Options.mod
@@ -672,6 +672,16 @@ BEGIN
END GetCpp ;
+(*
+ GetLineDirectives - returns TRUE if line directives are allowed.
+*)
+
+PROCEDURE GetLineDirectives () : BOOLEAN ;
+BEGIN
+ RETURN LineDirectives
+END GetLineDirectives ;
+
+
(*
SetPPOnly - set the PPonly (preprocess only) to value.
*)
diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h
index a03fdc5975f..4b3a23f18db 100644
--- a/gcc/m2/gm2-gcc/m2options.h
+++ b/gcc/m2/gm2-gcc/m2options.h
@@ -104,6 +104,7 @@ EXTERN void M2Options_FinaliseOptions (void);
EXTERN void M2Options_SetDebugFunctionLineNumbers (bool value);
EXTERN void M2Options_SetGenerateStatementNote (bool value);
EXTERN bool M2Options_GetCpp (void);
+EXTERN bool M2Options_GetLineDirectives (void);
EXTERN bool M2Options_GetM2g (void);
EXTERN bool M2Options_SetM2g (bool value);
EXTERN bool M2Options_SetLowerCaseKeywords (bool value);
diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc
index bde68368e1f..fc70fbb50bf 100644
--- a/gcc/m2/gm2-lang.cc
+++ b/gcc/m2/gm2-lang.cc
@@ -193,7 +193,8 @@ gm2_langhook_init_options (unsigned int
decoded_options_count,
switch (code)
{
case OPT_fcpp:
- gcc_checking_assert (building_cpp_command);
+ if (value)
+ gcc_checking_assert (building_cpp_command);
break;
case OPT_fcpp_begin:
in_cpp_args = true;
diff --git a/gcc/m2/m2.flex b/gcc/m2/m2.flex
index e8ee383878e..d874db9dae2 100644
--- a/gcc/m2/m2.flex
+++ b/gcc/m2/m2.flex
@@ -160,8 +160,14 @@ extern void yylex (void);
<COMMENTC>. { updatepos(); skippos(); }
<COMMENTC>\n.* { consumeLine(); }
<COMMENTC>"*/" { endOfCComment(); }
-^\#.* { consumeLine(); /* printf("found: %s\n",
currentLine->linebuf); */ BEGIN LINE0; }
-\n\#.* { consumeLine(); /* printf("found: %s\n",
currentLine->linebuf); */ BEGIN LINE0; }
+^\#.* { consumeLine(); /* printf("found: %s\n",
currentLine->linebuf); */
+ if (M2Options_GetLineDirectives ())
+ BEGIN LINE0;
+ }
+\n\#.* { consumeLine(); /* printf("found: %s\n",
currentLine->linebuf); */
+ if (M2Options_GetLineDirectives ())
+ BEGIN LINE0;
+ }
<LINE0>\#[ \t]* { updatepos(); }
<LINE0>[0-9]+[ \t]*\" { updatepos(); lineno=atoi(yytext); BEGIN LINE1; }
<LINE0>\n { m2flex_M2Error("missing initial quote after #line
directive"); resetpos(); BEGIN INITIAL; }
diff --git a/gcc/testsuite/gm2/cpp/fail/hashfirstcolumn2.mod
b/gcc/testsuite/gm2/cpp/fail/hashfirstcolumn2.mod
new file mode 100644
index 00000000000..34f63c96827
--- /dev/null
+++ b/gcc/testsuite/gm2/cpp/fail/hashfirstcolumn2.mod
@@ -0,0 +1,18 @@
+MODULE hashfirstcolumn2 ;
+
+FROM libc IMPORT printf, exit ;
+
+VAR
+ x, y: CARDINAL ;
+BEGIN
+ x := 1 ;
+ y := 2 ;
+ IF x
+# y
+ THEN
+ printf ("success\n");
+ ELSE
+ printf ("failure\n");
+ exit (1)
+ END
+END hashfirstcolumn2.
diff --git a/gcc/testsuite/gm2/imports/fail/imports-fail.exp
b/gcc/testsuite/gm2/imports/fail/imports-fail.exp
new file mode 100644
index 00000000000..0ba5e0c6640
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/fail/imports-fail.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2024 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mul...@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/pim/fail ${srcdir}/gm2/imports/fail"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture-fail $testcase
+}
diff --git a/gcc/testsuite/gm2/imports/fail/localmodule2.mod
b/gcc/testsuite/gm2/imports/fail/localmodule2.mod
new file mode 100644
index 00000000000..469965ace8d
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/fail/localmodule2.mod
@@ -0,0 +1,27 @@
+MODULE localmodule2 ;
+
+FROM libc IMPORT printf ;
+
+PROCEDURE mult2 (n: CARDINAL) : CARDINAL ;
+BEGIN
+ RETURN 2*n
+END mult2 ;
+
+MODULE local ;
+
+ EXPORT mysqr ;
+ IMPORT mult2 ;
+
+ PROCEDURE mysqr (n: CARDINAL) : CARDINAL ;
+ BEGIN
+ RETURN mult2 (n) * mult2 (n)
+ END mysqr ;
+
+END local ;
+
+VAR
+ d: CARDINAL ;
+BEGIN
+ d := mysqr (3) ;
+ printf ("sqr (3 * 2) = %d\n", d)
+END localmodule2.
diff --git a/gcc/testsuite/gm2/imports/run/pass/localmodule.mod
b/gcc/testsuite/gm2/imports/run/pass/localmodule.mod
new file mode 100644
index 00000000000..07c5cc11c7b
--- /dev/null
+++ b/gcc/testsuite/gm2/imports/run/pass/localmodule.mod
@@ -0,0 +1,27 @@
+MODULE localmodule ;
+
+FROM libc IMPORT printf ;
+
+PROCEDURE mult2 (n: CARDINAL) : CARDINAL ;
+BEGIN
+ RETURN 2*n
+END mult2 ;
+
+MODULE local ;
+
+ IMPORT mult2 ;
+ EXPORT mysqr ;
+
+ PROCEDURE mysqr (n: CARDINAL) : CARDINAL ;
+ BEGIN
+ RETURN mult2 (n) * mult2 (n)
+ END mysqr ;
+
+END local ;
+
+VAR
+ d: CARDINAL ;
+BEGIN
+ d := mysqr (3) ;
+ printf ("sqr (3 * 2) = %d\n", d)
+END localmodule.
