re PR fortran/83113 (Bogus "duplicate allocatable attribute" error for submodule...

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

	PR fortran/83113
	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-17  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/83113
	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.

From-SVN: r277122

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2064cf1314b1117b9d847d71dcfb2e8c8b2cc1c1..66ff7f143fe836eb68c9f3a1ef15049edb44695c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2019-10-17  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/83113
+       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-11  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/91715

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 7b87bb88a30e8db75faaaaf6e4dc313f0c2afaba..24002ed1c6e8cd2901808f6d7ed46b659644d7b1 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -7230,13 +7230,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)
@@ -7250,6 +7253,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
@@ -7488,15 +7509,15 @@ 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).  */
@@ -7696,13 +7717,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.  */
@@ -7744,6 +7768,24 @@ gfc_match_subroutine (void)
           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)
        if (!arg->sym)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9ee59f0c43ea61f2c07a98b2ee521463821aa835..4de50acd4824a0351bbd195ee7b600b53f703670 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2019-10-17  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/83113
+       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.
+
 2019-10-17  Bill Schmidt  <wschmidt@linux.ibm.com>
 
        Backport from mainline

diff --git a/gcc/testsuite/gfortran.dg/pr89943_1.f90 b/gcc/testsuite/gfortran.dg/pr89943_1.f90
new file mode 100644 (file)
index 0000000..3aa9c36
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr89943_1.f90
@@ -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
+

diff --git a/gcc/testsuite/gfortran.dg/pr89943_2.f90 b/gcc/testsuite/gfortran.dg/pr89943_2.f90
new file mode 100644 (file)
index 0000000..ac69ec3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr89943_2.f90
@@ -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
+

diff --git a/gcc/testsuite/gfortran.dg/pr89943_3.f90 b/gcc/testsuite/gfortran.dg/pr89943_3.f90
new file mode 100644 (file)
index 0000000..38b723e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr89943_3.f90
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/pr89943_4.f90 b/gcc/testsuite/gfortran.dg/pr89943_4.f90
new file mode 100644 (file)
index 0000000..8eba2ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr89943_4.f90
@@ -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