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

classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

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

Steve Kargl
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  <[hidden email]>
>
> 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  <[hidden email]>
>
> 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