PR fortran/47054 -- Don't search parent namespace for symbol
diff mbox series

Message ID 20191004232423.GA51528@troutmask.apl.washington.edu
State New
Headers show
Series
  • PR fortran/47054 -- Don't search parent namespace for symbol
Related show

Commit Message

Steve Kargl Oct. 4, 2019, 11:24 p.m. UTC
I plan to commit this as obviously correct tomorrow morning.
However, as the bug has been open for nearly 9 years, I give
anyone reading this a chance to speak up.

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

 PR fortran/47045
 * decl.c (variable_decl): Do not search parent namespace for symbol.

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

 PR fortran/47045
 * gfortran.dg/pr47054_1.f90: New test
 * gfortran.dg/pr47054_2.f90: Ditto.

Patch
diff mbox series

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 276601)
+++ gcc/fortran/decl.c	(working copy)
@@ -2682,7 +2682,7 @@  variable_decl (int elem)
       then we want to set the type & bail out.  */
   if (flag_cray_pointer && !gfc_comp_struct (gfc_current_state ()))
     {
-      gfc_find_symbol (name, gfc_current_ns, 1, &sym);
+      gfc_find_symbol (name, gfc_current_ns, 0, &sym);
       if (sym != NULL && sym->attr.cray_pointee)
 	{
 	  m = MATCH_YES;
@@ -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/pr47054_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr47054_1.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr47054_1.f90	(working copy)
@@ -0,0 +1,15 @@ 
+! { dg-do compile }
+! { dg-options "-fcray-pointer" }
+! PR fortran/47054
+subroutine host_sub
+   implicit none
+   real xg
+   pointer (paxg, xg)
+   call internal_sub
+   contains 
+      subroutine internal_sub
+         implicit none
+         real xg
+         pointer (paxg, xg)
+      end subroutine internal_sub
+end subroutine host_sub
Index: gcc/testsuite/gfortran.dg/pr47054_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr47054_2.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr47054_2.f90	(working copy)
@@ -0,0 +1,41 @@ 
+! { dg-do compile }
+! { dg-options "-fcray-pointer" }
+! PR fortran/47054
+! Code contributed by Deji Akingunola <deji_aking at yahoo dot ca>
+subroutine host_sub(F_su,F_nk)
+   implicit none
+   
+   integer :: F_nk
+   real,dimension(F_nk) :: F_su
+      integer G_ni, G_nj
+      real*8 G_xg_8, G_yg_8
+      pointer (paxg_8, G_xg_8(G_ni))
+      pointer (payg_8, G_yg_8(G_nj))
+      common / G_p / paxg_8,payg_8
+      common / G / G_ni, G_nj
+   
+   call internal_sub(F_su,F_nk)
+   return
+contains 
+   
+   subroutine internal_sub(F_su,F_nk)
+      implicit none
+      integer G_ni, G_nj
+      real*8 G_xg_8, G_yg_8
+      pointer (paxg_8, G_xg_8(G_ni))
+      pointer (payg_8, G_yg_8(G_nj))
+      common / G_p / paxg_8,payg_8
+      common / G / G_ni, G_nj
+     
+      integer :: F_nk
+      real,dimension(F_nk) :: F_su 
+      integer k,k2
+      
+      k2 = 0
+      do k = 1, F_nk, 2
+         k2 = k2+1
+               F_su(k) = F_su(k) + 1.0
+      enddo
+      return
+   end subroutine internal_sub
+end subroutine host_sub