mirror of
https://gcc.gnu.org/git/gcc.git
synced 2024-11-23 19:03:59 +08:00
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.
This commit is contained in:
parent
c09deceb53
commit
ba9fa68405
@ -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;
|
||||
}
|
||||
|
||||
|
@ -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
|
||||
|
80
gcc/testsuite/gfortran.dg/finalize_37.f90
Normal file
80
gcc/testsuite/gfortran.dg/finalize_37.f90
Normal file
@ -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" } }
|
Loading…
Reference in New Issue
Block a user