public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH] PR fortran/89943 -- Duplicate BIND(c) allowed (?)
@ 2019-10-04 22:26 Steve Kargl
  2019-10-11 18:50 ` Steve Kargl
  0 siblings, 1 reply; 5+ messages in thread
From: Steve Kargl @ 2019-10-04 22:26 UTC (permalink / raw)
  To: fortran, gcc-patches

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

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

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

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
+

^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [PATCH] PR fortran/89943 -- Duplicate BIND(c) allowed (?)
  2019-10-04 22:26 [PATCH] PR fortran/89943 -- Duplicate BIND(c) allowed (?) Steve Kargl
@ 2019-10-11 18:50 ` Steve Kargl
  2019-10-12 14:22   ` Paul Richard Thomas
  0 siblings, 1 reply; 5+ messages in thread
From: Steve Kargl @ 2019-10-11 18:50 UTC (permalink / raw)
  To: fortran, gcc-patches

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

^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [PATCH] PR fortran/89943 -- Duplicate BIND(c) allowed (?)
  2019-10-11 18:50 ` Steve Kargl
@ 2019-10-12 14:22   ` Paul Richard Thomas
  2019-10-14 20:09     ` Steve Kargl
  0 siblings, 1 reply; 5+ messages in thread
From: Paul Richard Thomas @ 2019-10-12 14:22 UTC (permalink / raw)
  To: Steve Kargl; +Cc: fortran, gcc-patches

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

^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [PATCH] PR fortran/89943 -- Duplicate BIND(c) allowed (?)
  2019-10-12 14:22   ` Paul Richard Thomas
@ 2019-10-14 20:09     ` Steve Kargl
  2019-10-14 20:25       ` Paul Richard Thomas
  0 siblings, 1 reply; 5+ messages in thread
From: Steve Kargl @ 2019-10-14 20:09 UTC (permalink / raw)
  To: Paul Richard Thomas; +Cc: fortran, gcc-patches

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

^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [PATCH] PR fortran/89943 -- Duplicate BIND(c) allowed (?)
  2019-10-14 20:09     ` Steve Kargl
@ 2019-10-14 20:25       ` Paul Richard Thomas
  0 siblings, 0 replies; 5+ messages in thread
From: Paul Richard Thomas @ 2019-10-14 20:25 UTC (permalink / raw)
  To: Steve Kargl; +Cc: fortran, gcc-patches

Steve,

Brilliant! Yes, it's good to commit.

Thanks

Paul

On Mon, 14 Oct 2019 at 21:06, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
>
> 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



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

^ permalink raw reply	[flat|nested] 5+ messages in thread

end of thread, other threads:[~2019-10-14 20:19 UTC | newest]

Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-10-04 22:26 [PATCH] PR fortran/89943 -- Duplicate BIND(c) allowed (?) Steve Kargl
2019-10-11 18:50 ` Steve Kargl
2019-10-12 14:22   ` Paul Richard Thomas
2019-10-14 20:09     ` Steve Kargl
2019-10-14 20:25       ` Paul Richard Thomas

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).