From: Tobias Burnus <tobias@codesourcery.com>
Date: Thu, 17 Dec 2020 09:39:09 +0000 (+0100)
Subject: Fortran: Delay vtab generation until after parsing [PR92587]
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ba9fa684053917a07bfa8f4742da0e196e72b9a2;p=gcc.git

Fortran: Delay vtab generation until after parsing [PR92587]

gcc/fortran/ChangeLog:

	PR fortran/92587
	* match.c (gfc_match_assignment): Move gfc_find_vtab call from here ...
	* resolve.c (gfc_resolve_code): ... to here.

gcc/testsuite/ChangeLog:

	PR fortran/92587
	* gfortran.dg/finalize_37.f90: New test.
---

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index bee73e7b008..c13fe96ed33 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1389,9 +1389,6 @@ gfc_match_assignment (void)
 
   gfc_check_do_variable (lvalue->symtree);
 
-  if (lvalue->ts.type == BT_CLASS)
-    gfc_find_vtab (&rvalue->ts);
-
   return MATCH_YES;
 }
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 05a5e43c90b..1da7ba4d031 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11896,6 +11896,9 @@ start:
 	  if (!t)
 	    break;
 
+	  if (code->expr1->ts.type == BT_CLASS)
+	   gfc_find_vtab (&code->expr2->ts);
+
 	  /* Remove a GFC_ISYM_CAF_GET inserted for a coindexed variable on
 	     the LHS.  */
 	  if (code->expr1->expr_type == EXPR_FUNCTION
diff --git a/gcc/testsuite/gfortran.dg/finalize_37.f90 b/gcc/testsuite/gfortran.dg/finalize_37.f90
new file mode 100644
index 00000000000..6d5be0247c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_37.f90
@@ -0,0 +1,80 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/92587
+!
+
+module m
+  implicit none (type, external)
+  type t2
+  contains
+    final :: fini
+  end type
+  type t3
+    type(t2) :: a
+  end type
+  type, extends(t3) :: t4
+  end type
+  class(t4), allocatable :: y
+  class(t4), allocatable :: z
+  integer :: fini_cnt = 0
+contains
+  subroutine sub
+    y = z
+  end
+  subroutine fini(x)
+    type(t2) :: x
+    fini_cnt = fini_cnt + 1
+  end
+end
+
+module m2
+  use m
+  implicit none (type, external)
+  type, extends(t3) :: t5
+  end type
+  type, extends(t3) :: t6
+  contains
+    final :: fin2
+  end type
+  integer :: fin2_cnt = 0
+contains
+  subroutine bar(x, y, z)
+    class(t4), allocatable, intent(out) :: x
+    class(t5), allocatable, intent(out) :: y
+    class(t6), allocatable, intent(out) :: z
+  end
+  subroutine fin2 (x)
+    type(t6) :: x
+    fin2_cnt = fin2_cnt + 1
+  end
+end  
+
+  use m
+  use m2
+  implicit none (type, external)
+  class(t4), allocatable :: x2
+  class(t5), allocatable :: y2
+  class(t6), allocatable :: z2
+
+  if (fini_cnt /= 0 .or. fin2_cnt /= 0) stop 1
+  call bar (x2, y2, z2)
+  if (fini_cnt /= 0 .or. fin2_cnt /= 0) stop 2
+  if (allocated(x2) .or. allocated(y2) .or. allocated(z2)) stop 3
+
+  allocate(t4 :: x2)
+  allocate(t5 :: y2)
+  allocate(t6 :: z2)
+  call bar (x2, y2, z2)
+  if (fini_cnt /= 3 .or. fin2_cnt /= 1) stop 4
+  if (allocated(x2) .or. allocated(y2) .or. allocated(z2)) stop 5
+
+  allocate(t6 :: z2)
+  call bar (x2, y2, z2)
+  if (fini_cnt /= 4 .or. fin2_cnt /= 2) stop 6
+  if (allocated(x2) .or. allocated(y2) .or. allocated(z2)) stop 7
+end
+
+! { dg-final { scan-tree-dump "__final_m_T2 \\\(struct" "original" } }
+! { dg-final { scan-tree-dump "__final_m_T3 \\\(struct" "original" } }
+! { dg-final { scan-tree-dump "__final_m2_T6 \\\(struct" "original" } }