From: Paul Thomas Date: Sun, 5 Nov 2017 12:38:42 +0000 (+0000) Subject: re PR fortran/81447 ([7/8] gfortran fails to recognize the exact dynamic type of... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=aea5e9327a49bc73878a547d490bb32ac31df03e;p=gcc.git re PR fortran/81447 ([7/8] gfortran fails to recognize the exact dynamic type of a polymorphic entity that was allocated in a external procedure) 2017-11-05 Paul Thomas PR fortran/81447 PR fortran/82783 * resolve.c (resolve_component): There is no need to resolve the components of a use associated vtype. (resolve_fl_derived): Unconditionally generate a vtable for any module derived type, as long as the standard is F2003 or later and it is not a vtype or a PDT template. 2017-11-05 Paul Thomas PR fortran/81447 * gfortran.dg/class_65.f90: New test. * gfortran.dg/alloc_comp_basics_1.f90: Increase builtin_free count from 18 to 21. * gfortran.dg/allocatable_scalar_9.f90: Increase builtin_free count from 32 to 54. * gfortran.dg/auto_dealloc_1.f90: Increase builtin_free count from 4 to 10. * gfortran.dg/coarray_lib_realloc_1.f90: Increase builtin_free count from 3 to 6. Likewise _gfortran_caf_deregister from 2 to 3, builtin_malloc from 1 to 4 and builtin_memcpy|= MEM from 2 to 5. * gfortran.dg/finalize_28.f90: Increase builtin_free count from 3 to 6. * gfortran.dg/move_alloc_15.f90: Increase builtin_free and builtin_malloc counts from 11 to 14. * gfortran.dg/typebound_proc_27.f03: Increase builtin_free count from 7 to 10. Likewise builtin_malloc from 12 to 15. From-SVN: r254427 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 008d86fe060..1a4da461e1c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2017-11-05 Paul Thomas + + PR fortran/81447 + PR fortran/82783 + * resolve.c (resolve_component): There is no need to resolve + the components of a use associated vtype. + (resolve_fl_derived): Unconditionally generate a vtable for any + module derived type, as long as the standard is F2003 or later + and it is not a vtype or a PDT template. + 2017-11-05 Tom de Vries PR other/82784 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 40c1cd3c96f..50b4b49fe97 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13496,6 +13496,9 @@ resolve_component (gfc_component *c, gfc_symbol *sym) if (c->attr.artificial) return true; + if (sym->attr.vtype && sym->attr.use_assoc) + return true; + /* F2008, C442. */ if ((!sym->attr.is_class || c != sym->components) && c->attr.codimension @@ -14075,6 +14078,20 @@ resolve_fl_derived (gfc_symbol *sym) if (!resolve_typebound_procedures (sym)) return false; + /* Generate module vtables subject to their accessibility and their not + being vtables or pdt templates. If this is not done class declarations + in external procedures wind up with their own version and so SELECT TYPE + fails because the vptrs do not have the same address. */ + if (gfc_option.allow_std & GFC_STD_F2003 + && sym->ns->proc_name + && sym->ns->proc_name->attr.flavor == FL_MODULE + && sym->attr.access != ACCESS_PRIVATE + && !(sym->attr.use_assoc || sym->attr.vtype || sym->attr.pdt_template)) + { + gfc_symbol *vtab = gfc_find_derived_vtab (sym); + gfc_set_sym_referenced (vtab); + } + return true; } @@ -15943,7 +15960,7 @@ resolve_equivalence (gfc_equiv *eq) { gfc_use_rename *r; for (r = sym->ns->use_stmts->rename; r; r = r->next) - if (strcmp(r->use_name, sym->name) == 0) saw_sym = true; + if (strcmp(r->use_name, sym->name) == 0) saw_sym = true; } else saw_sym = true; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e4ab15974e0..993dca9fee7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,24 @@ +2017-11-05 Paul Thomas + + PR fortran/81447 + * gfortran.dg/class_65.f90: New test. + * gfortran.dg/alloc_comp_basics_1.f90: Increase builtin_free + count from 18 to 21. + * gfortran.dg/allocatable_scalar_9.f90: Increase builtin_free + count from 32 to 54. + * gfortran.dg/auto_dealloc_1.f90: Increase builtin_free + count from 4 to 10. + * gfortran.dg/coarray_lib_realloc_1.f90: Increase builtin_free + count from 3 to 6. Likewise _gfortran_caf_deregister from 2 to + 3, builtin_malloc from 1 to 4 and builtin_memcpy|= MEM from + 2 to 5. + * gfortran.dg/finalize_28.f90: Increase builtin_free + count from 3 to 6. + * gfortran.dg/move_alloc_15.f90: Increase builtin_free and + builtin_malloc counts from 11 to 14. + * gfortran.dg/typebound_proc_27.f03: Increase builtin_free + count from 7 to 10. Likewise builtin_malloc from 12 to 15. + 2017-11-04 Daniel Santos gcc.target/i386/pr82002-2a.c: Change from xfail to fail. diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 index 0b5ef274cc4..44d1c8bc0e6 100644 --- a/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 +++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 @@ -141,4 +141,4 @@ contains end subroutine check_alloc2 end program alloc -! { dg-final { scan-tree-dump-times "builtin_free" 18 "original" } } +! { dg-final { scan-tree-dump-times "builtin_free" 21 "original" } } diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_9.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_9.f90 index d36175cd8d3..802c5f7bc8d 100644 --- a/gcc/testsuite/gfortran.dg/allocatable_scalar_9.f90 +++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_9.f90 @@ -5,13 +5,13 @@ ! ! Contributed by Tobias Burnus -module m -type st - integer , allocatable :: a1 -end type st -type at - integer , allocatable :: a2(:) -end type at +module m +type st + integer , allocatable :: a1 +end type st +type at + integer , allocatable :: a2(:) +end type at type t1 type(st), allocatable :: b1 @@ -52,4 +52,4 @@ if(allocated(na4%b4)) call abort() end block end -! { dg-final { scan-tree-dump-times "__builtin_free" 32 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 54 "original" } } diff --git a/gcc/testsuite/gfortran.dg/auto_dealloc_1.f90 b/gcc/testsuite/gfortran.dg/auto_dealloc_1.f90 index 4f15bcd6159..99ecd1df856 100644 --- a/gcc/testsuite/gfortran.dg/auto_dealloc_1.f90 +++ b/gcc/testsuite/gfortran.dg/auto_dealloc_1.f90 @@ -50,7 +50,7 @@ contains m%k%i = 45 end subroutine -end module +end module -! { dg-final { scan-tree-dump-times "__builtin_free" 4 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 10 "original" } } diff --git a/gcc/testsuite/gfortran.dg/class_65.f90 b/gcc/testsuite/gfortran.dg/class_65.f90 new file mode 100644 index 00000000000..a82918c2087 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_65.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +! +! Test the fix for PR81447 in which a vtable was not being created +! in the module 'm' so that x->vptr in 's' did not have the same +! value as that in 'p'. +! +! Contributed by Mat Cross +! +Module m + Type :: t + integer :: i + End Type +End Module + +Program p + Use m + Class (t), Allocatable :: x + Interface + Subroutine s(x) + Use m + Class (t), Allocatable :: x + End Subroutine + End Interface + Call s(x) + Select Type (x) + Type Is (t) + Continue + Class Is (t) + call abort + Class Default + call abort + End Select +! Print *, 'ok' +End Program + +Subroutine s(x) + Use m, Only: t + Implicit None + Class (t), Allocatable :: x + Allocate (t :: x) +End Subroutine diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_realloc_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_realloc_1.f90 index c55507b5821..559d880b5ac 100644 --- a/gcc/testsuite/gfortran.dg/coarray_lib_realloc_1.f90 +++ b/gcc/testsuite/gfortran.dg/coarray_lib_realloc_1.f90 @@ -21,14 +21,14 @@ x = y end ! For comp%ii: End of scope of x + y (2x) and for the LHS of the assignment (1x) -! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 6 "original" } } ! For comp%CAF: End of scope of x + y (2x); no LHS freeing for the CAF in assignment -! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister" 2 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister" 3 "original" } } ! Only malloc "ii": -! { dg-final { scan-tree-dump-times "__builtin_malloc" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_malloc" 4 "original" } } ! But copy "ii" and "CAF": -! { dg-final { scan-tree-dump-times "__builtin_memcpy|= MEM" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_memcpy|= MEM" 5 "original" } } diff --git a/gcc/testsuite/gfortran.dg/finalize_28.f90 b/gcc/testsuite/gfortran.dg/finalize_28.f90 index 03de5d0d28b..f0c9665252f 100644 --- a/gcc/testsuite/gfortran.dg/finalize_28.f90 +++ b/gcc/testsuite/gfortran.dg/finalize_28.f90 @@ -21,4 +21,4 @@ contains integer, intent(out) :: edges(:,:) end subroutine coo_dump_edges end module coo_graphs -! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 6 "original" } } diff --git a/gcc/testsuite/gfortran.dg/move_alloc_15.f90 b/gcc/testsuite/gfortran.dg/move_alloc_15.f90 index 1c96ccba1cf..0c8cacf3cf0 100644 --- a/gcc/testsuite/gfortran.dg/move_alloc_15.f90 +++ b/gcc/testsuite/gfortran.dg/move_alloc_15.f90 @@ -84,5 +84,5 @@ contains end do end subroutine end program name -! { dg-final { scan-tree-dump-times "__builtin_malloc" 11 "original" } } -! { dg-final { scan-tree-dump-times "__builtin_free" 11 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_malloc" 14 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 14 "original" } } diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_27.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_27.f03 index 29332c4169c..06484942277 100644 --- a/gcc/testsuite/gfortran.dg/typebound_proc_27.f03 +++ b/gcc/testsuite/gfortran.dg/typebound_proc_27.f03 @@ -1,6 +1,6 @@ ! { dg-do run } ! { dg-options "-fdump-tree-original" } -! +! ! PR fortran/47586 ! Missing deep copy for data pointer returning functions when the type ! has allocatable components @@ -77,15 +77,15 @@ end program prog ! statements. ! It is assumed that if the number of allocate is right, the number of ! deep copies is right too. -! { dg-final { scan-tree-dump-times "__builtin_malloc" 12 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_malloc" 15 "original" } } ! ! Realloc are only used for assignments to `that%i'. Don't know why. ! { dg-final { scan-tree-dump-times "__builtin_realloc" 6 "original" } } -! +! ! No leak: Only assignments to `this' use malloc. Assignments to `that%i' ! take the realloc path after the first assignment, so don't count as a malloc. -! { dg-final { scan-tree-dump-times "__builtin_free" 7 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 10 "original" } } !