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 <ka...@gcc.gnu.org>
PR fortran/47045
* decl.c (variable_decl): Do not search parent namespace for symbol.
2019-10-04 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/47045
* gfortran.dg/pr47054_1.f90: New test
* gfortran.dg/pr47054_2.f90: Ditto.
--
Steve
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
