Whoops, hit send to fast. Here's the patch committed. - Andre
On Sun, 20 Nov 2016 15:23:16 +0100 Andre Vehreschild <ve...@gmx.de> wrote: > Hi Janus, > > thanks for the review. Committed to trunk as r242637. Will wait one week > before committing to 6. > > Regards, > Andre > > On Sat, 19 Nov 2016 16:14:54 +0100 > Janus Weil <ja...@gcc.gnu.org> wrote: > > > Hi Andre, > > > > > When checking the shortened example in comment #3 one gets a segfault, > > > because v6 is not allocated explicitly. The initial example made sure, > > > that v6 was allocated. > > > > sorry, I guess that's my fault. I blindly removed the allocate > > statement when looking for a reduced test case for the compile-time > > error. > > > > > > > Btw, when using the in gcc-7 available > > > polymorphic assign, then v6 is actually auto-allocated and the program > > > runs fine. So what are your opinions on the auto-allocation issue? > > > > I suspect that auto-allocation does not apply to defined assignment, > > but I'm not fully sure. Looking in the F08 standard, it seems to be > > mentioned in 7.2.1.3, but not in 7.2.1.4. > > > > As Thomas mentioned, you could take that question to c.l.f. to get a > > more qualified answer and/or open a follow-up PR for it. > > > > > > > This patch fixes the wrong error messages in both gcc-7 and gcc-6. > > > Bootstraped and regtested on x86_64-linux/F23 for gcc-7 and -6. Ok for > > > trunk and gcc-6? > > > > Yes, looks good to me (at least for trunk; gcc-6 if you like). > > > > Thanks for the patch, > > Janus > > -- Andre Vehreschild * Email: vehre ad gmx dot de
Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (Revision 242636) +++ gcc/fortran/ChangeLog (Arbeitskopie) @@ -1,3 +1,9 @@ +2016-11-20 Andre Vehreschild <ve...@gcc.gnu.org> + + PR fortran/78395 + * resolve.c (resolve_typebound_function): Prevent stripping of refs, + when the base-expression is a class' typed one. + 2016-11-18 Richard Sandiford <richard.sandif...@arm.com> Alan Hayward <alan.hayw...@arm.com> David Sherwood <david.sherw...@arm.com> Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (Revision 242636) +++ gcc/fortran/resolve.c (Arbeitskopie) @@ -6140,7 +6140,7 @@ gfc_free_ref_list (class_ref->next); class_ref->next = NULL; } - else if (e->ref && !class_ref) + else if (e->ref && !class_ref && expr->ts.type != BT_CLASS) { gfc_free_ref_list (e->ref); e->ref = NULL; Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 242636) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,3 +1,8 @@ +2016-11-20 Andre Vehreschild <ve...@gcc.gnu.org> + + PR fortran/78395 + * gfortran.dg/typebound_operator_21.f03: New test. + 2016-11-20 Marc Glisse <marc.gli...@inria.fr> * gcc.dg/tree-ssa/divide-5.c: New file. Index: gcc/testsuite/gfortran.dg/typebound_operator_21.f03 =================================================================== --- gcc/testsuite/gfortran.dg/typebound_operator_21.f03 (nicht existent) +++ gcc/testsuite/gfortran.dg/typebound_operator_21.f03 (Arbeitskopie) @@ -0,0 +1,78 @@ +! { dg-do run } +! +! Test that pr78395 is fixed. +! Contributed by Chris MacMackin and Janus Weil + +module types_mod + implicit none + + type, public :: t1 + integer :: a + contains + procedure :: get_t2 + end type + + type, public :: t2 + integer :: b + contains + procedure, pass(rhs) :: mul2 + procedure :: assign + generic :: operator(*) => mul2 + generic :: assignment(=) => assign + end type + +contains + + function get_t2(this) + class(t1), intent(in) :: this + class(t2), allocatable :: get_t2 + type(t2), allocatable :: local + allocate(local) + local%b = this%a + call move_alloc(local, get_t2) + end function + + function mul2(lhs, rhs) + class(t2), intent(in) :: rhs + integer, intent(in) :: lhs + class(t2), allocatable :: mul2 + type(t2), allocatable :: local + allocate(local) + local%b = rhs%b*lhs + call move_alloc(local, mul2) + end function + + subroutine assign(this, rhs) + class(t2), intent(out) :: this + class(t2), intent(in) :: rhs + select type(rhs) + type is(t2) + this%b = rhs%b + class default + error stop + end select + end subroutine + +end module + + +program minimal + use types_mod + implicit none + + class(t1), allocatable :: v4 + class(t2), allocatable :: v6 + + allocate(v4, source=t1(4)) + allocate(v6) + v6 = 3 * v4%get_t2() + + select type (v6) + type is (t2) + if (v6%b /= 12) error stop + class default + error stop + end select + deallocate(v4, v6) +end +