From: Tobias Burnus <tobias@codesourcery.com>
Date: Tue, 5 Jan 2021 11:29:09 +0000 (+0100)
Subject: Fortran: Delay vtab generation until after parsing [PR92587]
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=a2e5f70b610bb61606c19d68b2910485397a907f;p=thirdparty%2Fgcc.git

Fortran: Delay vtab generation until after parsing [PR92587]

Forward port of GCC 10 commit 6f3f06e431c181d3e51d31f49a2bf0be2944ae93
which is a backport of mainline commit ba9fa684053917a07bfa8f4742da0e196e72b9a2

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.

(cherry picked from commit ba9fa684053917a07bfa8f4742da0e196e72b9a2)
---

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index e12c7ac4e9c7..39a3682c9258 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,12 @@
+2021-01-04  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2020-12-17  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/92587
+	* match.c (gfc_match_assignment): Move gfc_find_vtab call from here ...
+	* resolve.c (gfc_resolve_code): ... to here.
+
 2020-09-17  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backport from mainline
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index cb09c5f8ec53..a582f9262655 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 c9dfcc474336..84b50118348a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11842,6 +11842,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/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 7705855308d1..ed435aff6b67 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,11 @@
+2021-01-04  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2020-12-17  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/92587
+	* gfortran.dg/finalize_37.f90: New test.
+
 2020-12-18  Kwok Cheung Yeung  <kcy@codesourcery.com>
 
 	Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/finalize_37.f90 b/gcc/testsuite/gfortran.dg/finalize_37.f90
new file mode 100644
index 000000000000..6d5be0247c96
--- /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" } }