[Patch, fortran] PR100110 - Parameterized Derived Types, problems with global variable

[Paul Richard Thomas <paul.richard.thomas@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 914 bytes --]

Hi All,

I was just about to announce that I will only do backports and regressions,
while I finally attack the fundamental problem with the representation of
Parameterized Derived Types. Then this PR came up that was such clear low
hanging fruit that I decided to fix it right away.

Regtests on FC33/x86_64 - OK for mainline?

Note that this is sufficiently safe that it could be applied to 11-branch
right now. However, I am prepared to hold off until 11-branch is released.

Regards

Paul

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

2021-04-19  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.

[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 1575 bytes --]

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 34a0d49bae7..cc9d85543ca 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 bf1273743d3..59ddcfb6cc4 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" } }

[-- Attachment #3: pdt_31.f03 --]
[-- Type: application/octet-stream, Size: 586 bytes --]

! { 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