diff mbox series

PR fortran/84519 - [F2018] STOP and ERROR STOP statements with QUIET specifier

Message ID trinity-86837fc5-81ea-4245-9f63-d8c2eafbf232-1645654903030@3c-app-gmx-bap14
State New
Headers show
Series PR fortran/84519 - [F2018] STOP and ERROR STOP statements with QUIET specifier | expand

Commit Message

Harald Anlauf Feb. 23, 2022, 10:21 p.m. UTC
Dear Fortranners,

Fortran 2018 added a QUIET= specifier to STOP and ERROR STOP statements.
Janne already implemented the library side code four (4!) years ago,
but so far the frontend implementation was missing.

Furthermore, F2018 allows for non-default-integer stopcode expressions
(finally!).

The attached patch provides this implementation.

That was not too much fun for the following reasons:

- fixed format vs. free format
- F95 and F2003 apparently did not require a blank between STOP and
  stopcode, while F2008+ do require it.

This should explain for the three testcases.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

One step closer to F2018!

Thanks,
Harald

Comments

Jerry D Feb. 24, 2022, 3:07 a.m. UTC | #1
On 2/23/22 2:21 PM, Harald Anlauf via Fortran wrote:
> Dear Fortranners,
>
> Fortran 2018 added a QUIET= specifier to STOP and ERROR STOP statements.
> Janne already implemented the library side code four (4!) years ago,
> but so far the frontend implementation was missing.
>
> Furthermore, F2018 allows for non-default-integer stopcode expressions
> (finally!).
>
> The attached patch provides this implementation.
>
> That was not too much fun for the following reasons:
>
> - fixed format vs. free format
> - F95 and F2003 apparently did not require a blank between STOP and
>    stopcode, while F2008+ do require it.
>
> This should explain for the three testcases.
>
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>
> One step closer to F2018!
>
> Thanks,
> Harald
>
A minor comment.  Is there a way to also have a run-time test case?

OK to commit now and additional test case can be added if necessary later.

Regards,

Jerry
Mikael Morin Feb. 24, 2022, 11:50 a.m. UTC | #2
Le 23/02/2022 à 23:21, Harald Anlauf via Fortran a écrit :
> Dear Fortranners,
> 
> Fortran 2018 added a QUIET= specifier to STOP and ERROR STOP statements.
> Janne already implemented the library side code four (4!) years ago,
> but so far the frontend implementation was missing.
> 
> Furthermore, F2018 allows for non-default-integer stopcode expressions
> (finally!).
> 
> The attached patch provides this implementation.
> 
> That was not too much fun for the following reasons:
> 
> - fixed format vs. free format
> - F95 and F2003 apparently did not require a blank between STOP and
>    stopcode, while F2008+ do require it.
> 
> This should explain for the three testcases.
> 
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
> 
> One step closer to F2018!
> 
Please move the error from trans-stmt.cc to resolve.cc.
Otherwise looks good, and you have a green light by Jerry, but I would 
rather defer this to gcc-13.

Mikael
Harald Anlauf Feb. 24, 2022, 8:06 p.m. UTC | #3
Dear Jerry, Mikael,

thanks for the feedback!

Am 24.02.22 um 12:50 schrieb Mikael Morin:
> Le 23/02/2022 à 23:21, Harald Anlauf via Fortran a écrit :
>> Dear Fortranners,
>>
>> Fortran 2018 added a QUIET= specifier to STOP and ERROR STOP statements.
>> Janne already implemented the library side code four (4!) years ago,
>> but so far the frontend implementation was missing.
>>
>> Furthermore, F2018 allows for non-default-integer stopcode expressions
>> (finally!).
>>
>> The attached patch provides this implementation.
>>
>> That was not too much fun for the following reasons:
>>
>> - fixed format vs. free format
>> - F95 and F2003 apparently did not require a blank between STOP and
>>    stopcode, while F2008+ do require it.
>>
>> This should explain for the three testcases.
>>
>> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
>>
>> One step closer to F2018!
>>
> Please move the error from trans-stmt.cc to resolve.cc.

That is certainly cleaner.  I've done this and rerun the regtest.

As suggested by Jerry a simple run-time testcase with QUIET=.true. has
been added.  However, since I could not find a way to convince dejagnu
that there should be no output, I simply check that the right values
are passed to the runtime library.

If somebody knows how to solve this and feels strongly about this,
please proceed.

Pushed as https://gcc.gnu.org/g:916b809fbfdd2740006270baf549bf22fe9ec3c4

> Otherwise looks good, and you have a green light by Jerry, but I would
> rather defer this to gcc-13.
>
> Mikael
>

Thanks,
Harald
diff mbox series

Patch

From 66e80a9847b3e16d4c619ba8da9f3dba891cff34 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 23 Feb 2022 23:08:29 +0100
Subject: [PATCH] Fortran: frontend code for F2018 QUIET specifier to STOP and
 ERROR STOP

Fortran 2018 allows for a QUIET specifier to the STOP and ERROR STOP
statements.  Whilst the gfortran library code provides support for this
specifier for quite some time, the frontend implementation was missing.

gcc/fortran/ChangeLog:

	PR fortran/84519
	* dump-parse-tree.cc (show_code_node): Dump QUIET specifier when
	present.
	* match.cc (gfc_match_stopcode): Implement parsing of F2018 QUIET
	specifier.  F2018 stopcodes may have non-default integer kind.
	* trans-stmt.cc (gfc_trans_stop): Pass QUIET specifier to call of
	library function.

gcc/testsuite/ChangeLog:

	PR fortran/84519
	* gfortran.dg/stop_1.f90: New test.
	* gfortran.dg/stop_2.f: New test.
	* gfortran.dg/stop_3.f90: New test.
---
 gcc/fortran/dump-parse-tree.cc       |  5 +++
 gcc/fortran/match.cc                 | 62 +++++++++++++++++++++++-----
 gcc/fortran/trans-stmt.cc            | 21 ++++++++--
 gcc/testsuite/gfortran.dg/stop_1.f90 | 44 ++++++++++++++++++++
 gcc/testsuite/gfortran.dg/stop_2.f   | 31 ++++++++++++++
 gcc/testsuite/gfortran.dg/stop_3.f90 | 22 ++++++++++
 6 files changed, 172 insertions(+), 13 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/stop_1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/stop_2.f
 create mode 100644 gcc/testsuite/gfortran.dg/stop_3.f90

diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 2a2f9901b08..322416e6556 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -2370,6 +2370,11 @@  show_code_node (int level, gfc_code *c)
 	show_expr (c->expr1);
       else
 	fprintf (dumpfile, "%d", c->ext.stop_code);
+      if (c->expr2 != NULL)
+	{
+	  fputs (" QUIET=", dumpfile);
+	  show_expr (c->expr2);
+	}

       break;

diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 8edfe4a3a2d..715a74eba51 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -2978,6 +2978,13 @@  Fortran 2008 has
    R856 allstop-stmt  is ALL STOP [ stop-code ]
    R857 stop-code     is scalar-default-char-constant-expr
                       or scalar-int-constant-expr
+Fortran 2018 has
+
+   R1160 stop-stmt       is STOP [ stop-code ] [ , QUIET = scalar-logical-expr]
+   R1161 error-stop-stmt is
+                      ERROR STOP [ stop-code ] [ , QUIET = scalar-logical-expr]
+   R1162 stop-code       is scalar-default-char-expr
+                         or scalar-int-expr

 For free-form source code, all standards contain a statement of the form:

@@ -2994,8 +3001,10 @@  static match
 gfc_match_stopcode (gfc_statement st)
 {
   gfc_expr *e = NULL;
+  gfc_expr *quiet = NULL;
   match m;
   bool f95, f03, f08;
+  char c;

   /* Set f95 for -std=f95.  */
   f95 = (gfc_option.allow_std == GFC_STD_OPT_F95);
@@ -3006,11 +3015,16 @@  gfc_match_stopcode (gfc_statement st)
   /* Set f08 for -std=f2008.  */
   f08 = (gfc_option.allow_std == GFC_STD_OPT_F08);

-  /* Look for a blank between STOP and the stop-code for F2008 or later.  */
-  if (gfc_current_form != FORM_FIXED && !(f95 || f03))
-    {
-      char c = gfc_peek_ascii_char ();
+  /* Plain STOP statement?  */
+  if (gfc_match_eos () == MATCH_YES)
+    goto checks;
+
+  /* Look for a blank between STOP and the stop-code for F2008 or later.
+     But allow for F2018's ,QUIET= specifier.  */
+  c = gfc_peek_ascii_char ();

+  if (gfc_current_form != FORM_FIXED && !(f95 || f03) && c != ',')
+    {
       /* Look for end-of-statement.  There is no stop-code.  */
       if (c == '\n' || c == '!' || c == ';')
         goto done;
@@ -3023,7 +3037,12 @@  gfc_match_stopcode (gfc_statement st)
 	}
     }

-  if (gfc_match_eos () != MATCH_YES)
+  if (c == ' ')
+    {
+      gfc_gobble_whitespace ();
+      c = gfc_peek_ascii_char ();
+    }
+  if (c != ',')
     {
       int stopcode;
       locus old_locus;
@@ -3053,11 +3072,20 @@  gfc_match_stopcode (gfc_statement st)
 	goto cleanup;
       if (m == MATCH_NO)
 	goto syntax;
+    }

-      if (gfc_match_eos () != MATCH_YES)
-	goto syntax;
+  if (gfc_match (" , quiet = %e", &quiet) == MATCH_YES)
+    {
+      if (!gfc_notify_std (GFC_STD_F2018, "QUIET= specifier for %s at %L",
+			   gfc_ascii_statement (st), &quiet->where))
+	goto cleanup;
     }

+  if (gfc_match_eos () != MATCH_YES)
+    goto syntax;
+
+checks:
+
   if (gfc_pure (NULL))
     {
       if (st == ST_ERROR_STOP)
@@ -3133,10 +3161,22 @@  gfc_match_stopcode (gfc_statement st)
 	  goto cleanup;
 	}

-      if (e->ts.type == BT_INTEGER && e->ts.kind != gfc_default_integer_kind)
+      if (e->ts.type == BT_INTEGER && e->ts.kind != gfc_default_integer_kind
+	  && !gfc_notify_std (GFC_STD_F2018,
+			      "STOP code at %L must be default integer KIND=%d",
+			      &e->where, (int) gfc_default_integer_kind))
+	goto cleanup;
+    }
+
+  if (quiet != NULL)
+    {
+      if (!gfc_simplify_expr (quiet, 0))
+	goto cleanup;
+
+      if (quiet->rank != 0)
 	{
-	  gfc_error ("STOP code at %L must be default integer KIND=%d",
-		     &e->where, (int) gfc_default_integer_kind);
+	  gfc_error ("QUIET specifier at %L must be a scalar LOGICAL",
+		     &quiet->where);
 	  goto cleanup;
 	}
     }
@@ -3159,6 +3199,7 @@  done:
     }

   new_st.expr1 = e;
+  new_st.expr2 = quiet;
   new_st.ext.stop_code = -1;

   return MATCH_YES;
@@ -3169,6 +3210,7 @@  syntax:
 cleanup:

   gfc_free_expr (e);
+  gfc_free_expr (quiet);
   return MATCH_ERROR;
 }

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 30b6bd5dd2a..e1307aaab66 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -652,11 +652,26 @@  gfc_trans_stop (gfc_code *code, bool error_stop)
 {
   gfc_se se;
   tree tmp;
+  tree quiet;

   /* Start a new block for this statement.  */
   gfc_init_se (&se, NULL);
   gfc_start_block (&se.pre);

+  if (code->expr2)
+    {
+      if (code->expr2->ts.type != BT_LOGICAL || code->expr2->rank != 0)
+	{
+	  gfc_error ("QUIET specifier at %L must be a scalar LOGICAL",
+		     &code->expr2->where);
+	  return NULL_TREE;
+	}
+      gfc_conv_expr_val (&se, code->expr2);
+      quiet = fold_convert (boolean_type_node, se.expr);
+    }
+  else
+    quiet = boolean_false_node;
+
   if (code->expr1 == NULL)
     {
       tmp = build_int_cst (size_type_node, 0);
@@ -669,7 +684,7 @@  gfc_trans_stop (gfc_code *code, bool error_stop)
 				    ? gfor_fndecl_caf_stop_str
 				    : gfor_fndecl_stop_string),
 				 3, build_int_cst (pchar_type_node, 0), tmp,
-				 boolean_false_node);
+				 quiet);
     }
   else if (code->expr1->ts.type == BT_INTEGER)
     {
@@ -683,7 +698,7 @@  gfc_trans_stop (gfc_code *code, bool error_stop)
 				    ? gfor_fndecl_caf_stop_numeric
 				    : gfor_fndecl_stop_numeric), 2,
 				 fold_convert (integer_type_node, se.expr),
-				 boolean_false_node);
+				 quiet);
     }
   else
     {
@@ -698,7 +713,7 @@  gfc_trans_stop (gfc_code *code, bool error_stop)
 				    : gfor_fndecl_stop_string),
 				 3, se.expr, fold_convert (size_type_node,
 							   se.string_length),
-				 boolean_false_node);
+				 quiet);
     }

   gfc_add_expr_to_block (&se.pre, tmp);
diff --git a/gcc/testsuite/gfortran.dg/stop_1.f90 b/gcc/testsuite/gfortran.dg/stop_1.f90
new file mode 100644
index 00000000000..3e00455ba4e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stop_1.f90
@@ -0,0 +1,44 @@ 
+! { dg-do compile }
+! { dg-options "-std=f2018" }
+
+  implicit none
+  logical      :: q = .false.
+  integer(2)   :: p = 99
+  real         :: x = 0.
+  character(5) :: s = "stopp"
+  print *, "Hello"
+  stop 1, quiet=.false.
+  stop 2, quiet=q
+  stop 3, quiet=f(x)
+  stop; stop!
+  stop ;stop 4!
+  stop 5; stop 6
+  stop 7 ;stop 8
+  stop 1_1; stop 2_2; stop 4_4; stop 8_8
+  stop&!
+       &;stop;&!
+       stop&!
+       s&
+       ; stop "x";&!
+       ; st&!
+       &op&!
+       p
+  stop s
+  if(f(x))then;stop 9,quiet=.false.;else;stop 10;endif
+  error stop 4, quiet=.true.
+  error stop 5 , quiet=.true.
+  error stop s, quiet=.true.
+  stop "last " // s, quiet=.false._2
+  stop, quiet=any([.false.])
+  stop , quiet=any([f(x)])
+  stop "stopp" , quiet=any([f(x)])
+  stop s, quiet=all([f(x)])
+  stop42, quiet=.false.            ! { dg-error "Blank required" }
+  stop"stopp" , quiet=any([f(x)])  ! { dg-error "Blank required" }
+  stop 8, quiet=([f(x)])           ! { dg-error "must be a scalar LOGICAL" }
+contains
+  logical function f(x)
+    real, intent(in) :: x
+    f = .false.
+  end function f
+end
diff --git a/gcc/testsuite/gfortran.dg/stop_2.f b/gcc/testsuite/gfortran.dg/stop_2.f
new file mode 100644
index 00000000000..24fb91350cd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stop_2.f
@@ -0,0 +1,31 @@ 
+! { dg-do compile }
+! { dg-options "-std=f2018" }
+
+      implicit none
+      logical      :: q = .false.
+      integer(2)   :: p = 99
+      real         :: x = 0.
+      character(5) :: s = "stopp"
+      stop 1, quiet=.false.
+      stop 2, quiet=q
+      stop 3, quiet=f(x)
+      stop42,quiet=.false.
+      error stop 4, quiet=.true.
+      error stop 5 , quiet=.true.
+      stop1_1;stop2_2;stop4_4;stop8_8
+      stopp;stops
+      st
+     &op42
+      stop, quiet=any([.false.])
+      stop , quiet=any([f(x)])
+      stop"stopp",quiet=any([f(x)])
+      stop "stopp" , quiet=any([f(x)])
+      s to ps,quiet=all([f(x)])
+      e r r o r s t o p 4 3 , q u i e t = . t r u e .
+      errorstop"stopp",quiet=.not.f(x)
+      contains
+      logical function f(x)
+      real, intent(in) :: x
+      f = .false.
+      end function f
+      end
diff --git a/gcc/testsuite/gfortran.dg/stop_3.f90 b/gcc/testsuite/gfortran.dg/stop_3.f90
new file mode 100644
index 00000000000..bc153dd3455
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stop_3.f90
@@ -0,0 +1,22 @@ 
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! F95 and F2003 do not require a blank after STOP
+
+  implicit none
+  integer,      parameter :: p = 99
+  character(*), parameter :: s = "stopp"
+  stop1
+  stop2!
+  stop3;stop4!
+  stopp
+  stop&!
+       &;stop;&!
+       stop&!
+       s&
+       ;stop"x";&!
+       ;st&!
+       &op&!
+       p
+  stops
+  stop"last " // s
+end
--
2.34.1