From: Paul Thomas <pault@gcc.gnu.org>
Date: Tue, 20 Apr 2021 06:30:07 +0000 (+0100)
Subject: Fortran: Fix host associated PDT entity initialization [PR99307].
X-Git-Tag: basepoints/gcc-12~2
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=67378cd63d62bf0c69e966d1d202a1e586550a68;p=thirdparty%2Fgcc.git

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 34a0d49bae7e..cc9d85543ca6 100644
--- 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 bf1273743d37..59ddcfb6cc43 100644
--- 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
index 000000000000..708c94542179
--- /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