OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/47054 (Compilation error when cray pointers are declared in both host and internal subroutines)

Browse Source 
2019-10-05  Steven G. Kargl  <kargl@gcc.gnu.org>

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

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

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

From-SVN: r276627
This commit is contained in:
Steven G. Kargl 2019-10-05 15:23:26 +00:00
parent 74e4fb1361
commit 2345fe52da
5 changed files with 14229 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
2019-10-05 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/47045
* decl.c (variable_decl): Do not search parent namespace for symbol.
2019-10-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/91926

2
gcc/fortran/decl.c
View File

@ -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;

14167
gcc/testsuite/ChangeLog
View File

File diff suppressed because it is too large Load Diff

15
gcc/testsuite/gfortran.dg/pr47054_1.f90 Normal file
View File

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

41
gcc/testsuite/gfortran.dg/pr47054_2.f90 Normal file
View File

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