PR fortran/105501 - check for non-optional spaces between adjacent keywords

Message ID trinity-927b057e-4950-4ce5-bf8f-4ec039fab04b-1652041031263@3c-app-gmx-bs41
State New
Headers
Series PR fortran/105501 - check for non-optional spaces between adjacent keywords |

Commit Message

Harald Anlauf May 8, 2022, 8:17 p.m. UTC
  Dear all,

the PR correctly notes that a space between keywords 'TYPE' and 'IS' is
required in free-form, but we currently accept 'TYPEIS'.  We shouldn't.
The combinations with non-optional blanks are listed in the standard;
in F2018 this is table 6.2.

While at it, I saw a couple of other keyword combinations in the matcher
and fixed these too.  I cross-checked my findings with Intel, Crayftn,
and NAG (as far as possible).

Regarding the testcase: I do not know how to write a (single!) testcase
that is able to check multiple of those fixes.  I also do not think that
it makes sense to provide a testcase for each single fixed pattern.
Therefore a provided a single, minimal testcase based on the report.

Regtested on x86_64-pc-linux-gnu.  OK for mainline (i.e. 13-master)?

Thanks,
Harald
  

Comments

Mikael Morin May 9, 2022, 6:24 p.m. UTC | #1
Le 08/05/2022 à 22:17, Harald Anlauf via Fortran a écrit :
> Dear all,
> 
> the PR correctly notes that a space between keywords 'TYPE' and 'IS' is
> required in free-form, but we currently accept 'TYPEIS'.  We shouldn't.
> The combinations with non-optional blanks are listed in the standard;
> in F2018 this is table 6.2.
> 
> While at it, I saw a couple of other keyword combinations in the matcher
> and fixed these too.  I cross-checked my findings with Intel, Crayftn,
> and NAG (as far as possible).
> 
> Regarding the testcase: I do not know how to write a (single!) testcase
> that is able to check multiple of those fixes.  I also do not think that
> it makes sense to provide a testcase for each single fixed pattern.
> Therefore a provided a single, minimal testcase based on the report.
> 
> Regtested on x86_64-pc-linux-gnu.  OK for mainline (i.e. 13-master)?
> 
The fix itself looks good.  Regarding the test, I don’t understand the 
problem.  Can’t there be multiple subroutines, each having one (or more) 
problematic statement(s)?
  
Harald Anlauf May 9, 2022, 7:34 p.m. UTC | #2
Hi Mikael,

Am 09.05.22 um 20:24 schrieb Mikael Morin:
> The fix itself looks good.  Regarding the test, I don’t understand the
> problem.  Can’t there be multiple subroutines, each having one (or more)
> problematic statement(s)?

that's why I tried but failed.  Example:

subroutine a
   errorstop
end
subroutine b
   errorstop
end

This now gives just one (the first) error, after which it bails out:

xxx.f90:2:3:

     2 |   errorstop
       |   1
Error: Unclassifiable statement at (1)

That is the reason I mentioned it.

I'll commit the patch as-is.

Thanks for the review!
Harald
  
Mikael Morin May 10, 2022, 11:54 a.m. UTC | #3
Le 09/05/2022 à 21:34, Harald Anlauf a écrit :
> Hi Mikael,
> 
> Am 09.05.22 um 20:24 schrieb Mikael Morin:
>> The fix itself looks good.  Regarding the test, I don’t understand the
>> problem.  Can’t there be multiple subroutines, each having one (or more)
>> problematic statement(s)?
> 
> that's why I tried but failed.  Example:
> 
> subroutine a
>    errorstop
> end
> subroutine b
>    errorstop
> end
> 
> This now gives just one (the first) error, after which it bails out:
> 
Indeed, I think it’s a bug.
I have submitted a PR for it.
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=105547

Thanks for the patch.
  

Patch

From 8b04cb084e138966cf20187887da676ad9e4a00e Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sun, 8 May 2022 22:04:27 +0200
Subject: [PATCH] Fortran: check for non-optional spaces between adjacent
 keywords

In free format, spaces between adjacent keywords are not optional except
when a combination is explicitly listed (e.g. F2018: table 6.2).  The
following combinations thus require separating blanks: CHANGE TEAM,
ERROR STOP, EVENT POST, EVENT WAIT, FAIL IMAGE, FORM TEAM, SELECT RANK,
SYNC ALL, SYNC IMAGES, SYNC MEMORY, SYNC TEAM, TYPE IS.

gcc/fortran/ChangeLog:

	PR fortran/105501
	* match.cc (gfc_match_if): Adjust patterns used for matching.
	(gfc_match_select_rank): Likewise.
	* parse.cc (decode_statement): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/105501
	* gfortran.dg/pr105501.f90: New test.
---
 gcc/fortran/match.cc                   | 22 +++++++++++-----------
 gcc/fortran/parse.cc                   | 22 +++++++++++-----------
 gcc/testsuite/gfortran.dg/pr105501.f90 | 15 +++++++++++++++
 3 files changed, 37 insertions(+), 22 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pr105501.f90

diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 205811bb969..1aa3053e70e 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -1606,21 +1606,21 @@  gfc_match_if (gfc_statement *if_type)
   match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT)
   match ("backspace", gfc_match_backspace, ST_BACKSPACE)
   match ("call", gfc_match_call, ST_CALL)
-  match ("change team", gfc_match_change_team, ST_CHANGE_TEAM)
+  match ("change% team", gfc_match_change_team, ST_CHANGE_TEAM)
   match ("close", gfc_match_close, ST_CLOSE)
   match ("continue", gfc_match_continue, ST_CONTINUE)
   match ("cycle", gfc_match_cycle, ST_CYCLE)
   match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE)
   match ("end file", gfc_match_endfile, ST_END_FILE)
   match ("end team", gfc_match_end_team, ST_END_TEAM)
-  match ("error stop", gfc_match_error_stop, ST_ERROR_STOP)
-  match ("event post", gfc_match_event_post, ST_EVENT_POST)
-  match ("event wait", gfc_match_event_wait, ST_EVENT_WAIT)
+  match ("error% stop", gfc_match_error_stop, ST_ERROR_STOP)
+  match ("event% post", gfc_match_event_post, ST_EVENT_POST)
+  match ("event% wait", gfc_match_event_wait, ST_EVENT_WAIT)
   match ("exit", gfc_match_exit, ST_EXIT)
-  match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE)
+  match ("fail% image", gfc_match_fail_image, ST_FAIL_IMAGE)
   match ("flush", gfc_match_flush, ST_FLUSH)
   match ("forall", match_simple_forall, ST_FORALL)
-  match ("form team", gfc_match_form_team, ST_FORM_TEAM)
+  match ("form% team", gfc_match_form_team, ST_FORM_TEAM)
   match ("go to", gfc_match_goto, ST_GOTO)
   match ("if", match_arithmetic_if, ST_ARITHMETIC_IF)
   match ("inquire", gfc_match_inquire, ST_INQUIRE)
@@ -1634,10 +1634,10 @@  gfc_match_if (gfc_statement *if_type)
   match ("rewind", gfc_match_rewind, ST_REWIND)
   match ("stop", gfc_match_stop, ST_STOP)
   match ("wait", gfc_match_wait, ST_WAIT)
-  match ("sync all", gfc_match_sync_all, ST_SYNC_CALL);
-  match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
-  match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
-  match ("sync team", gfc_match_sync_team, ST_SYNC_TEAM)
+  match ("sync% all", gfc_match_sync_all, ST_SYNC_CALL);
+  match ("sync% images", gfc_match_sync_images, ST_SYNC_IMAGES);
+  match ("sync% memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
+  match ("sync% team", gfc_match_sync_team, ST_SYNC_TEAM)
   match ("unlock", gfc_match_unlock, ST_UNLOCK)
   match ("where", match_simple_where, ST_WHERE)
   match ("write", gfc_match_write, ST_WRITE)
@@ -6716,7 +6716,7 @@  gfc_match_select_rank (void)
   if (m == MATCH_ERROR)
     return m;

-  m = gfc_match (" select rank ( ");
+  m = gfc_match (" select% rank ( ");
   if (m != MATCH_YES)
     return m;

diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index e6e915d2a5e..7356d1b5a3a 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -454,7 +454,7 @@  decode_statement (void)

     case 'c':
       match ("call", gfc_match_call, ST_CALL);
-      match ("change team", gfc_match_change_team, ST_CHANGE_TEAM);
+      match ("change% team", gfc_match_change_team, ST_CHANGE_TEAM);
       match ("close", gfc_match_close, ST_CLOSE);
       match ("continue", gfc_match_continue, ST_CONTINUE);
       match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL);
@@ -479,7 +479,7 @@  decode_statement (void)
       match ("else", gfc_match_else, ST_ELSE);
       match ("else where", gfc_match_elsewhere, ST_ELSEWHERE);
       match ("else if", gfc_match_elseif, ST_ELSEIF);
-      match ("error stop", gfc_match_error_stop, ST_ERROR_STOP);
+      match ("error% stop", gfc_match_error_stop, ST_ERROR_STOP);
       match ("enum , bind ( c )", gfc_match_enum, ST_ENUM);

       if (gfc_match_end (&st) == MATCH_YES)
@@ -488,15 +488,15 @@  decode_statement (void)
       match ("entry% ", gfc_match_entry, ST_ENTRY);
       match ("equivalence", gfc_match_equivalence, ST_EQUIVALENCE);
       match ("external", gfc_match_external, ST_ATTR_DECL);
-      match ("event post", gfc_match_event_post, ST_EVENT_POST);
-      match ("event wait", gfc_match_event_wait, ST_EVENT_WAIT);
+      match ("event% post", gfc_match_event_post, ST_EVENT_POST);
+      match ("event% wait", gfc_match_event_wait, ST_EVENT_WAIT);
       break;

     case 'f':
-      match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE);
+      match ("fail% image", gfc_match_fail_image, ST_FAIL_IMAGE);
       match ("final", gfc_match_final_decl, ST_FINAL);
       match ("flush", gfc_match_flush, ST_FLUSH);
-      match ("form team", gfc_match_form_team, ST_FORM_TEAM);
+      match ("form% team", gfc_match_form_team, ST_FORM_TEAM);
       match ("format", gfc_match_format, ST_FORMAT);
       break;

@@ -562,16 +562,16 @@  decode_statement (void)
       match ("save", gfc_match_save, ST_ATTR_DECL);
       match ("static", gfc_match_static, ST_ATTR_DECL);
       match ("submodule", gfc_match_submodule, ST_SUBMODULE);
-      match ("sync all", gfc_match_sync_all, ST_SYNC_ALL);
-      match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
-      match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
-      match ("sync team", gfc_match_sync_team, ST_SYNC_TEAM);
+      match ("sync% all", gfc_match_sync_all, ST_SYNC_ALL);
+      match ("sync% images", gfc_match_sync_images, ST_SYNC_IMAGES);
+      match ("sync% memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
+      match ("sync% team", gfc_match_sync_team, ST_SYNC_TEAM);
       break;

     case 't':
       match ("target", gfc_match_target, ST_ATTR_DECL);
       match ("type", gfc_match_derived_decl, ST_DERIVED_DECL);
-      match ("type is", gfc_match_type_is, ST_TYPE_IS);
+      match ("type% is", gfc_match_type_is, ST_TYPE_IS);
       break;

     case 'u':
diff --git a/gcc/testsuite/gfortran.dg/pr105501.f90 b/gcc/testsuite/gfortran.dg/pr105501.f90
new file mode 100644
index 00000000000..85492e2d41c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105501.f90
@@ -0,0 +1,15 @@ 
+! { dg-do compile }
+! PR fortran/105501 - check for non-optional spaces between adjacent keywords
+
+MODULE M
+  TYPE T
+     INTEGER I
+  END TYPE
+CONTAINS
+  SUBROUTINE S(X)
+    CLASS(T), POINTER :: X
+    SELECTTYPE (X) ! blank between SELECT and TYPE is optional
+    TYPEIS (T)     ! { dg-error "Mangled derived type definition" }
+    END SELECT
+  END SUBROUTINE
+END MODULE
--
2.35.3