Re: [PATCH] PR fortran/89943 -- Duplicate BIND(c) allowed (?)

[Steve Kargl <sgk@troutmask.apl.washington.edu>]

[-- Attachment #1: Type: text/plain, Size: 8750 bytes --]

See attached patch.  It includes my previous patch and
patch to check for C1550.  OK to commit?

2019-10-14  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/89943
	decl.c (gfc_match_function_decl): Ignore duplicate BIND(C) for function
	declaration in submodule.  Implement at check for F2018 C1550.
	(gfc_match_entry): Use temporary for locus, which allows removal of
	one gfc_error_now().
	(gfc_match_subroutine): Ignore duplicate BIND(C) for subroutine
	declaration in submodule.  Implement at check for F2018 C1550.

2019-10-14  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/89943
	* gfortran.dg/pr89943_1.f90: New test.
	* gfortran.dg/pr89943_2.f90: Ditto.
	* gfortran.dg/pr89943_3.f90: Ditto.
	* gfortran.dg/pr89943_4.f90: Ditto.



On Sat, Oct 12, 2019 at 02:57:25PM +0100, Paul Richard Thomas wrote:
> Hi Steve,
> 
> In the F2018 standard: C1550 (R1526) If MODULE appears in the prefix
> of a module subprogram and a binding label is specified, it
> shall be the same as the binding label specified in the corresponding
> module procedure interface body.
> 
> While it does not say explicitly that a repeat binding label is
> allowed, I think that the implication is clear enough.
> 
> The patch is OK as it is but it would be nice if C1550 is or would be
> implemented.
> 
> Thanks
> 
> Paul
> 
> On Fri, 11 Oct 2019 at 19:31, Steve Kargl
> <sgk@troutmask.apl.washington.edu> wrote:
> >
> > PING.
> >
> > On Fri, Oct 04, 2019 at 03:26:53PM -0700, Steve Kargl wrote:
> > > The attached patch allows the declaration of a BIND(C)
> > > module function or module subroutine to appear in a
> > > submodule (see testcases).  Regression test was clean.
> > > OK to commit?
> > >
> > > Before a rubber stamped 'OK'.  I do NOT use submodules.
> > > A submodule user needs to pipe up on the validity of
> > > the patch.
> > >
> > >
> > > 2019-10-04  Steven G. Kargl  <kargl@gcc.gnu.org>
> > >
> > >       PR fortran/89943
> > >       decl.c (gfc_match_function_decl): Ignore duplicate BIND(C) for function
> > >       declaration in submodule.
> > >       (gfc_match_entry): Use temporary for locus, which allows removal of
> > >       one gfc_error_now().
> > >       (gfc_match_subroutine): Ignore duplicate BIND(C) for subroutine
> > >       declaration in submodule.
> > >
> > > 2019-10-04  Steven G. Kargl  <kargl@gcc.gnu.org>
> > >
> > >       PR fortran/89943
> > >       * gfortran.dg/pr89943_1.f90: New test.
> > >       * gfortran.dg/pr89943_2.f90: Ditto.
> > >
> > > --
> > > Steve
> >
> > > Index: gcc/fortran/decl.c
> > > ===================================================================
> > > --- gcc/fortran/decl.c        (revision 276601)
> > > +++ gcc/fortran/decl.c        (working copy)
> > > @@ -7259,13 +7259,16 @@ gfc_match_function_decl (void)
> > >    if (sym->attr.is_bind_c == 1)
> > >      {
> > >        sym->attr.is_bind_c = 0;
> > > -      if (sym->old_symbol != NULL)
> > > -        gfc_error_now ("BIND(C) attribute at %L can only be used for "
> > > -                       "variables or common blocks",
> > > -                       &(sym->old_symbol->declared_at));
> > > -      else
> > > -        gfc_error_now ("BIND(C) attribute at %L can only be used for "
> > > -                       "variables or common blocks", &gfc_current_locus);
> > > +
> > > +      if (gfc_state_stack->previous
> > > +       && gfc_state_stack->previous->state != COMP_SUBMODULE)
> > > +     {
> > > +       locus loc;
> > > +       loc = sym->old_symbol != NULL
> > > +         ? sym->old_symbol->declared_at : gfc_current_locus;
> > > +       gfc_error_now ("BIND(C) attribute at %L can only be used for "
> > > +                      "variables or common blocks", &loc);
> > > +     }
> > >      }
> > >
> > >    if (found_match != MATCH_YES)
> > > @@ -7517,16 +7520,16 @@ gfc_match_entry (void)
> > >       not allowed for procedures.  */
> > >    if (entry->attr.is_bind_c == 1)
> > >      {
> > > +      locus loc;
> > > +
> > >        entry->attr.is_bind_c = 0;
> > > -      if (entry->old_symbol != NULL)
> > > -        gfc_error_now ("BIND(C) attribute at %L can only be used for "
> > > -                       "variables or common blocks",
> > > -                       &(entry->old_symbol->declared_at));
> > > -      else
> > > -        gfc_error_now ("BIND(C) attribute at %L can only be used for "
> > > -                       "variables or common blocks", &gfc_current_locus);
> > > -    }
> > >
> > > +      loc = entry->old_symbol != NULL
> > > +     ? entry->old_symbol->declared_at : gfc_current_locus;
> > > +      gfc_error_now ("BIND(C) attribute at %L can only be used for "
> > > +                  "variables or common blocks", &loc);
> > > +     }
> > > +
> > >    /* Check what next non-whitespace character is so we can tell if there
> > >       is the required parens if we have a BIND(C).  */
> > >    old_loc = gfc_current_locus;
> > > @@ -7725,13 +7728,16 @@ gfc_match_subroutine (void)
> > >    if (sym->attr.is_bind_c == 1)
> > >      {
> > >        sym->attr.is_bind_c = 0;
> > > -      if (sym->old_symbol != NULL)
> > > -        gfc_error_now ("BIND(C) attribute at %L can only be used for "
> > > -                       "variables or common blocks",
> > > -                       &(sym->old_symbol->declared_at));
> > > -      else
> > > -        gfc_error_now ("BIND(C) attribute at %L can only be used for "
> > > -                       "variables or common blocks", &gfc_current_locus);
> > > +
> > > +      if (gfc_state_stack->previous
> > > +       && gfc_state_stack->previous->state != COMP_SUBMODULE)
> > > +     {
> > > +       locus loc;
> > > +       loc = sym->old_symbol != NULL
> > > +         ? sym->old_symbol->declared_at : gfc_current_locus;
> > > +       gfc_error_now ("BIND(C) attribute at %L can only be used for "
> > > +                      "variables or common blocks", &loc);
> > > +     }
> > >      }
> > >
> > >    /* C binding names are not allowed for internal procedures.  */
> > > Index: gcc/testsuite/gfortran.dg/pr89943_1.f90
> > > ===================================================================
> > > --- gcc/testsuite/gfortran.dg/pr89943_1.f90   (nonexistent)
> > > +++ gcc/testsuite/gfortran.dg/pr89943_1.f90   (working copy)
> > > @@ -0,0 +1,31 @@
> > > +! { dg-do compile }
> > > +! PR fortran/89943
> > > +! Code contributed by Alberto Luaces  <aluaces at udc dot se>
> > > +module Foo_mod
> > > +
> > > +   implicit none
> > > +
> > > +   interface
> > > +      module subroutine runFoo4C(ndim) bind(C, name="runFoo")
> > > +         use, intrinsic :: iso_c_binding
> > > +         implicit none
> > > +         integer(c_int32_t) , intent(in) :: ndim
> > > +      end subroutine runFoo4C
> > > +   end interface
> > > +
> > > +   contains
> > > +
> > > +end module Foo_mod
> > > +
> > > +submodule(Foo_mod) Foo_smod
> > > +
> > > +   contains
> > > +
> > > +      module subroutine runFoo4C(ndim) bind(C, name="runFoo")
> > > +         use, intrinsic :: iso_c_binding
> > > +         implicit none
> > > +         integer(c_int32_t) , intent(in) :: ndim
> > > +      end subroutine runFoo4C
> > > +
> > > +end submodule Foo_smod
> > > +
> > > Index: gcc/testsuite/gfortran.dg/pr89943_2.f90
> > > ===================================================================
> > > --- gcc/testsuite/gfortran.dg/pr89943_2.f90   (nonexistent)
> > > +++ gcc/testsuite/gfortran.dg/pr89943_2.f90   (working copy)
> > > @@ -0,0 +1,33 @@
> > > +! { dg-do compile }
> > > +! PR fortran/89943
> > > +! Code contributed by Alberto Luaces  <aluaces at udc dot se>
> > > +module Foo_mod
> > > +
> > > +   implicit none
> > > +
> > > +   interface
> > > +      module function runFoo4C(ndim) bind(C, name="runFoo")
> > > +         use, intrinsic :: iso_c_binding
> > > +         implicit none
> > > +         integer runFoo4c
> > > +         integer(c_int32_t) , intent(in) :: ndim
> > > +      end function runFoo4C
> > > +   end interface
> > > +
> > > +   contains
> > > +
> > > +end module Foo_mod
> > > +
> > > +submodule(Foo_mod) Foo_smod
> > > +
> > > +   contains
> > > +
> > > +      module function runFoo4C(ndim) bind(C, name="runFoo")
> > > +         use, intrinsic :: iso_c_binding
> > > +         implicit none
> > > +         integer runFoo4c
> > > +         integer(c_int32_t) , intent(in) :: ndim
> > > +      end function runFoo4C
> > > +
> > > +end submodule Foo_smod
> > > +
> >
> >
> > --
> > Steve
> > 20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
> > 20161221 https://www.youtube.com/watch?v=IbCHE-hONow
> 
> 
> 
> -- 
> "If you can't explain it simply, you don't understand it well enough"
> - Albert Einstein

-- 
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow

[-- Attachment #2: pr.diff --]
[-- Type: text/x-diff, Size: 9178 bytes --]

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 276967)
+++ gcc/fortran/decl.c	(working copy)
@@ -7263,13 +7263,16 @@ gfc_match_function_decl (void)
   if (sym->attr.is_bind_c == 1)
     {
       sym->attr.is_bind_c = 0;
-      if (sym->old_symbol != NULL)
-        gfc_error_now ("BIND(C) attribute at %L can only be used for "
-                       "variables or common blocks",
-                       &(sym->old_symbol->declared_at));
-      else
-        gfc_error_now ("BIND(C) attribute at %L can only be used for "
-                       "variables or common blocks", &gfc_current_locus);
+
+      if (gfc_state_stack->previous
+	  && gfc_state_stack->previous->state != COMP_SUBMODULE)
+	{
+	  locus loc;
+	  loc = sym->old_symbol != NULL
+	    ? sym->old_symbol->declared_at : gfc_current_locus;
+	  gfc_error_now ("BIND(C) attribute at %L can only be used for "
+			 "variables or common blocks", &loc);
+	}
     }
 
   if (found_match != MATCH_YES)
@@ -7283,6 +7286,24 @@ gfc_match_function_decl (void)
 	found_match = suffix_match;
     }
 
+  /* F2018 C1550 (R1526) If MODULE appears in the prefix of a module
+     subprogram and a binding label is specified, it shall be the
+     same as the binding label specified in the corresponding module
+     procedure interface body.  */
+    if (sym->attr.is_bind_c && sym->attr.module_procedure && sym->old_symbol
+  	&& strcmp (sym->name, sym->old_symbol->name) == 0
+	&& strcmp (sym->binding_label, sym->old_symbol->binding_label) != 0)
+      {
+	  const char *null = "NULL", *s1, *s2;
+	  s1 = sym->binding_label;
+	  if (!s1) s1 = null;
+	  s2 = sym->old_symbol->binding_label;
+	  if (!s2) s2 = null;
+          gfc_error ("Mismatch in BIND(C) names (%qs/%qs) at %C", s1, s2);
+	  sym->refs++;	/* Needed to avoid an ICE in gfc_release_symbol */
+	  return MATCH_ERROR;
+      }
+
   if(found_match != MATCH_YES)
     m = MATCH_ERROR;
   else
@@ -7521,16 +7542,16 @@ gfc_match_entry (void)
      not allowed for procedures.  */
   if (entry->attr.is_bind_c == 1)
     {
+      locus loc;
+
       entry->attr.is_bind_c = 0;
-      if (entry->old_symbol != NULL)
-        gfc_error_now ("BIND(C) attribute at %L can only be used for "
-                       "variables or common blocks",
-                       &(entry->old_symbol->declared_at));
-      else
-        gfc_error_now ("BIND(C) attribute at %L can only be used for "
-                       "variables or common blocks", &gfc_current_locus);
-    }
 
+      loc = entry->old_symbol != NULL
+	? entry->old_symbol->declared_at : gfc_current_locus; 
+      gfc_error_now ("BIND(C) attribute at %L can only be used for "
+		     "variables or common blocks", &loc);
+     }
+
   /* Check what next non-whitespace character is so we can tell if there
      is the required parens if we have a BIND(C).  */
   old_loc = gfc_current_locus;
@@ -7729,13 +7750,16 @@ gfc_match_subroutine (void)
   if (sym->attr.is_bind_c == 1)
     {
       sym->attr.is_bind_c = 0;
-      if (sym->old_symbol != NULL)
-        gfc_error_now ("BIND(C) attribute at %L can only be used for "
-                       "variables or common blocks",
-                       &(sym->old_symbol->declared_at));
-      else
-        gfc_error_now ("BIND(C) attribute at %L can only be used for "
-                       "variables or common blocks", &gfc_current_locus);
+
+      if (gfc_state_stack->previous
+	  && gfc_state_stack->previous->state != COMP_SUBMODULE)
+	{
+	  locus loc;
+	  loc = sym->old_symbol != NULL
+	    ? sym->old_symbol->declared_at : gfc_current_locus;
+	  gfc_error_now ("BIND(C) attribute at %L can only be used for "
+			 "variables or common blocks", &loc);
+	}
     }
 
   /* C binding names are not allowed for internal procedures.  */
@@ -7776,6 +7800,24 @@ gfc_match_subroutine (void)
           gfc_error ("Missing required parentheses before BIND(C) at %C");
           return MATCH_ERROR;
         }
+
+      /* F2018 C1550 (R1526) If MODULE appears in the prefix of a module
+	 subprogram and a binding label is specified, it shall be the
+	 same as the binding label specified in the corresponding module
+	 procedure interface body.  */
+      if (sym->attr.module_procedure && sym->old_symbol
+  	  && strcmp (sym->name, sym->old_symbol->name) == 0
+	  && strcmp (sym->binding_label, sym->old_symbol->binding_label) != 0)
+	{
+	  const char *null = "NULL", *s1, *s2;
+	  s1 = sym->binding_label;
+	  if (!s1) s1 = null;
+	  s2 = sym->old_symbol->binding_label;
+	  if (!s2) s2 = null;
+          gfc_error ("Mismatch in BIND(C) names (%qs/%qs) at %C", s1, s2);
+	  sym->refs++;	/* Needed to avoid an ICE in gfc_release_symbol */
+	  return MATCH_ERROR;
+	}
 
       /* Scan the dummy arguments for an alternate return.  */
       for (arg = sym->formal; arg; arg = arg->next)
Index: gcc/testsuite/gfortran.dg/pr89943_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr89943_1.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr89943_1.f90	(working copy)
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! PR fortran/89943
+! Code contributed by Alberto Luaces  <aluaces at udc dot se>
+module Foo_mod
+
+   implicit none
+
+   interface
+      module subroutine runFoo4C(ndim) bind(C, name="runFoo")
+         use, intrinsic :: iso_c_binding
+         implicit none
+         integer(c_int32_t) , intent(in) :: ndim
+      end subroutine runFoo4C
+   end interface
+
+   contains
+
+end module Foo_mod
+
+submodule(Foo_mod) Foo_smod
+
+   contains
+
+      module subroutine runFoo4C(ndim) bind(C, name="runFoo")
+         use, intrinsic :: iso_c_binding
+         implicit none
+         integer(c_int32_t) , intent(in) :: ndim
+      end subroutine runFoo4C
+
+end submodule Foo_smod
+
Index: gcc/testsuite/gfortran.dg/pr89943_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr89943_2.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr89943_2.f90	(working copy)
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! PR fortran/89943
+! Code contributed by Alberto Luaces  <aluaces at udc dot se>
+module Foo_mod
+
+   implicit none
+
+   interface
+      module function runFoo4C(ndim) bind(C, name="runFoo")
+         use, intrinsic :: iso_c_binding
+         implicit none
+         integer runFoo4c
+         integer(c_int32_t) , intent(in) :: ndim
+      end function runFoo4C
+   end interface
+
+   contains
+
+end module Foo_mod
+
+submodule(Foo_mod) Foo_smod
+
+   contains
+
+      module function runFoo4C(ndim) bind(C, name="runFoo")
+         use, intrinsic :: iso_c_binding
+         implicit none
+         integer runFoo4c
+         integer(c_int32_t) , intent(in) :: ndim
+      end function runFoo4C
+
+end submodule Foo_smod
+
Index: gcc/testsuite/gfortran.dg/pr89943_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr89943_3.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr89943_3.f90	(working copy)
@@ -0,0 +1,28 @@
+! { dg-do compile }
+module Foo_mod
+
+   implicit none
+
+   interface
+      module subroutine runFoo4C(ndim) bind(C, name="runFoo")
+         use, intrinsic :: iso_c_binding
+         implicit none
+         integer(c_int32_t) , intent(in) :: ndim
+      end subroutine runFoo4C
+   end interface
+
+   contains
+
+end module Foo_mod
+
+submodule(Foo_mod) Foo_smod
+
+   contains
+
+      module subroutine runFoo4C(ndim) bind(C, name="runFu")   ! { dg-error "Mismatch in BIND" }
+         use, intrinsic :: iso_c_binding                 ! { dg-error "Unexpected USE statement" }
+         implicit none                                   ! { dg-error "Unexpected IMPLICIT NONE statement" }
+         integer(c_int32_t) , intent(in) :: ndim         ! { dg-error "Unexpected data declaration" }
+      end subroutine runFoo4C                            ! { dg-error " Expecting END SUBMODULE" }
+
+end submodule Foo_smod
Index: gcc/testsuite/gfortran.dg/pr89943_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr89943_4.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr89943_4.f90	(working copy)
@@ -0,0 +1,29 @@
+! { dg-do compile }
+module Foo_mod
+
+   implicit none
+
+   interface
+      module function runFoo4C(ndim) bind(C, name="runFoo")
+         use, intrinsic :: iso_c_binding
+         implicit none
+         integer runFoo4c
+         integer(c_int32_t) , intent(in) :: ndim
+      end function runFoo4C
+   end interface
+
+   contains
+
+end module Foo_mod
+
+submodule(Foo_mod) Foo_smod
+
+   contains
+
+      module function runFoo4C(ndim) bind(C, name="runFu")  ! { dg-error "Mismatch in BIND" }
+         use, intrinsic :: iso_c_binding     ! { dg-error "Unexpected USE statement in" }
+         implicit none                       ! { dg-error "Unexpected IMPLICIT NONE statement" }
+         integer(c_int32_t) , intent(in) :: ndim   ! { dg-error "Unexpected data declaration" }
+      end function runFoo4C                  ! { dg-error "Expecting END SUBMODULE" }
+
+end submodule Foo_smod