Dear All,
This patch is adequately described by the comment in the second chunk
applied to resolve.c.
Note, however, that the 'unconditionally' is promptly undermined by
the subsequent conditions. I will change the adjective appropriately.
In writing this, I have just realised that access=private need not
have a vtable generated unless it is required for a class within the
module. I will make it so a regtest once more.
Some of the increases in counts in the tree dumps look alarming. They
are however just a reflection of the number of derived types in some
of the tests and are due to the auxiliary vtable functions.
Bootstrapped and regtested on FC23/x86_64 - OK for trunk and then 7- branch?
Paul
2017-11-01 Paul Thomas <pa...@gcc.gnu.org>
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-01 Paul Thomas <pa...@gcc.gnu.org>
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.
Index: gcc/fortran/match.c
===================================================================
*** gcc/fortran/match.c (revision 254300)
--- gcc/fortran/match.c (working copy)
*************** gfc_match_allocate (void)
*** 4010,4019 ****
/* TODO understand why this error does not appear but, instead,
the derived type is caught as a variable in primary.c. */
! if (gfc_spec_list_type (type_param_spec_list, NULL) != SPEC_EXPLICIT)
{
gfc_error ("The type parameter spec list in the type-spec at "
! "%L cannot contain ASSUMED or DEFERRED parameters",
&old_locus);
goto cleanup;
}
--- 4010,4019 ----
/* TODO understand why this error does not appear but, instead,
the derived type is caught as a variable in primary.c. */
! if (gfc_spec_list_type (type_param_spec_list, NULL) == SPEC_DEFERRED)
{
gfc_error ("The type parameter spec list in the type-spec at "
! "%L cannot contain DEFERRED parameters",
&old_locus);
goto cleanup;
}
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 254300)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_component (gfc_component *c, gfc
*** 13496,13501 ****
--- 13496,13504 ----
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
*************** resolve_fl_derived (gfc_symbol *sym)
*** 14075,14080 ****
--- 14078,14096 ----
if (!resolve_typebound_procedures (sym))
return false;
+ /* Generate module vtables unconditionally. 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.use_assoc || sym->attr.vtype || sym->attr.pdt_template))
+ {
+ gfc_symbol *vtab = gfc_find_derived_vtab (sym);
+ gfc_set_sym_referenced (vtab);
+ }
+
return true;
}
Index: gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 (revision 254300)
--- gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 (working copy)
*************** contains
*** 141,144 ****
end subroutine check_alloc2
end program alloc
! ! { dg-final { scan-tree-dump-times "builtin_free" 18 "original" } }
--- 141,144 ----
end subroutine check_alloc2
end program alloc
! ! { dg-final { scan-tree-dump-times "builtin_free" 21 "original" } }
Index: gcc/testsuite/gfortran.dg/allocatable_scalar_9.f90
===================================================================
*** gcc/testsuite/gfortran.dg/allocatable_scalar_9.f90 (revision 254300)
--- gcc/testsuite/gfortran.dg/allocatable_scalar_9.f90 (working copy)
***************
*** 5,17 ****
!
! Contributed by Tobias Burnus <bur...@gcc.gnu.org>
! module m
! type st
! integer , allocatable :: a1
! end type st
! type at
! integer , allocatable :: a2(:)
! end type at
type t1
type(st), allocatable :: b1
--- 5,17 ----
!
! Contributed by Tobias Burnus <bur...@gcc.gnu.org>
! module m
! type st
! integer , allocatable :: a1
! end type st
! type at
! integer , allocatable :: a2(:)
! end type at
type t1
type(st), allocatable :: b1
*************** if(allocated(na4%b4)) call abort()
*** 52,55 ****
end block
end
! ! { dg-final { scan-tree-dump-times "__builtin_free" 32 "original" } }
--- 52,55 ----
end block
end
! ! { dg-final { scan-tree-dump-times "__builtin_free" 54 "original" } }
Index: gcc/testsuite/gfortran.dg/auto_dealloc_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/auto_dealloc_1.f90 (revision 254300)
--- gcc/testsuite/gfortran.dg/auto_dealloc_1.f90 (working copy)
*************** contains
*** 50,56 ****
m%k%i = 45
end subroutine
! end module
! ! { dg-final { scan-tree-dump-times "__builtin_free" 4 "original" } }
--- 50,56 ----
m%k%i = 45
end subroutine
! end module
! ! { dg-final { scan-tree-dump-times "__builtin_free" 10 "original" } }
Index: gcc/testsuite/gfortran.dg/class_65.f90
===================================================================
*** gcc/testsuite/gfortran.dg/class_65.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/class_65.f90 (working copy)
***************
*** 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 <math...@nag.co.uk>
+ !
+ 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
Index: gcc/testsuite/gfortran.dg/coarray_lib_realloc_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/coarray_lib_realloc_1.f90 (revision 254300)
--- gcc/testsuite/gfortran.dg/coarray_lib_realloc_1.f90 (working copy)
*************** x = y
*** 21,34 ****
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" } }
! 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" }
}
! Only malloc "ii":
! ! { dg-final { scan-tree-dump-times "__builtin_malloc" 1 "original" } }
! But copy "ii" and "CAF":
! ! { dg-final { scan-tree-dump-times "__builtin_memcpy|= MEM" 2 "original" } }
--- 21,34 ----
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" 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" 3 "original" }
}
! Only malloc "ii":
! ! { dg-final { scan-tree-dump-times "__builtin_malloc" 4 "original" } }
! But copy "ii" and "CAF":
! ! { dg-final { scan-tree-dump-times "__builtin_memcpy|= MEM" 5 "original" } }
Index: gcc/testsuite/gfortran.dg/finalize_28.f90
===================================================================
*** gcc/testsuite/gfortran.dg/finalize_28.f90 (revision 254300)
--- gcc/testsuite/gfortran.dg/finalize_28.f90 (working copy)
*************** contains
*** 21,24 ****
integer, intent(out) :: edges(:,:)
end subroutine coo_dump_edges
end module coo_graphs
! ! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } }
--- 21,24 ----
integer, intent(out) :: edges(:,:)
end subroutine coo_dump_edges
end module coo_graphs
! ! { dg-final { scan-tree-dump-times "__builtin_free" 6 "original" } }
Index: gcc/testsuite/gfortran.dg/move_alloc_15.f90
===================================================================
*** gcc/testsuite/gfortran.dg/move_alloc_15.f90 (revision 254300)
--- gcc/testsuite/gfortran.dg/move_alloc_15.f90 (working copy)
*************** contains
*** 84,88 ****
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" } }
--- 84,88 ----
end do
end subroutine
end program name
! ! { dg-final { scan-tree-dump-times "__builtin_malloc" 14 "original" } }
! ! { dg-final { scan-tree-dump-times "__builtin_free" 14 "original" } }
Index: gcc/testsuite/gfortran.dg/typebound_proc_27.f03
===================================================================
*** gcc/testsuite/gfortran.dg/typebound_proc_27.f03 (revision 254300)
--- gcc/testsuite/gfortran.dg/typebound_proc_27.f03 (working copy)
***************
*** 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
--- 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
*************** end program prog
*** 77,91 ****
! 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" } }
!
! 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" } }
!
--- 77,91 ----
! 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" 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" 10 "original" } }
!
