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)>

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}.

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.
 *)

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.
 *)

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);

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;

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; }

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.

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.mulley@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
+}

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.

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.