Fortran: Fix host associated PDT entity initialization [PR99307].

2021-04-20  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/100110
	* trans-decl.c (gfc_get_symbol_decl): Replace test for host
	association with a check that the current and symbol namespaces
	are the same.

gcc/testsuite/
	PR fortran/100110
	* gfortran.dg/pdt_31.f03: New test.
	* gfortran.dg/pdt_26.f03: Reduce 'builtin_malloc' count from 9
	to 8.

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 34a0d49..cc9d855 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1548,7 +1548,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
      declaration of the entity and memory allocated/deallocated.  */
   if ((sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
       && sym->param_list != NULL
-      && !(sym->attr.host_assoc || sym->attr.use_assoc || sym->attr.dummy))
+      && gfc_current_ns == sym->ns
+      && !(sym->attr.use_assoc || sym->attr.dummy))
     gfc_defer_symbol_init (sym);
 
   /* Dummy PDT 'len' parameters should be checked when they are explicit.  */

diff --git a/gcc/testsuite/gfortran.dg/pdt_26.f03 b/gcc/testsuite/gfortran.dg/pdt_26.f03
index bf12737..59ddcfb 100644 (file)
--- a/gcc/testsuite/gfortran.dg/pdt_26.f03
+++ b/gcc/testsuite/gfortran.dg/pdt_26.f03
@@ -2,7 +2,7 @@
 ! { dg-options "-fdump-tree-original" }
 !
 ! Test the fix for PR83567 in which the parameterized component 'foo' was
-! being deallocated before return from 'addw', with consequent segfault in 
+! being deallocated before return from 'addw', with consequent segfault in
 ! the main program.
 !
 ! Contributed by Berke Durak  <berke.durak@gmail.com>
@@ -43,4 +43,4 @@ program test_pdt
   if (any (c(1)%foo .ne. [13,15,17])) STOP 2
 end program test_pdt
 ! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } }
-! { dg-final { scan-tree-dump-times "__builtin_malloc" 9 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 8 "original" } }

diff --git a/gcc/testsuite/gfortran.dg/pdt_31.f03 b/gcc/testsuite/gfortran.dg/pdt_31.f03
new file mode 100644 (file)
index 0000000..708c945
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_31.f03
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! Test the fix for PR100110, in which 'obj' was not being initialized.
+!
+! Contributed by Xiao Liu  <xiao.liu@compiler-dev.com>
+!
+program p
+  implicit none
+  type t(n)
+    integer, len :: n
+    integer :: arr(n, n)
+  end type
+
+  type(t(2)) :: obj
+
+  obj%arr = reshape ([1,2,3,4],[2,2])
+  if (obj%n .ne. 2) stop 1
+  if (any (shape(obj%arr) .ne. [2,2])) stop 2
+  call test()
+contains
+  subroutine test()
+    if (obj%n .ne. 2) stop 3
+    if (any (shape(obj%arr) .ne. [2,2])) stop 4
+    if (any (reshape (obj%arr, [4]) .ne. [1,2,3,4])) stop 5
+  end subroutine
+end program