From 8b04cb084e138966cf20187887da676ad9e4a00e Mon Sep 17 00:00:00 2001 From: Harald Anlauf 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