From: Paul Thomas Date: Tue, 15 Jan 2013 05:29:01 +0000 (+0000) Subject: re PR fortran/54286 (Accepts invalid proc-pointer assignments involving proc-ptr... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=feb6eab0f59640cf19caa7bc09587b0c5a8a371f;p=gcc.git re PR fortran/54286 (Accepts invalid proc-pointer assignments involving proc-ptr function result) 2013-01-15 Paul Thomas PR fortran/54286 * expr.c (gfc_check_pointer_assign): Check for presence of 's2' before using it. 2013-01-15 Paul Thomas PR fortran/54286 * gfortran.dg/proc_ptr_result_8.f90 : Add module 'm' to check case where interface is null. From-SVN: r195185 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b412d0a97b9..f297deb93ad 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2013-01-15 Paul Thomas + + PR fortran/54286 + * expr.c (gfc_check_pointer_assign): Check for presence of + 's2' before using it. + 2013-01-14 Thomas Koenig PR fortran/55806 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 3010dd9e456..f358ac7665e 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3537,7 +3537,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) name = s2->name; } - if (s2->attr.proc_pointer && s2->ts.interface) + if (s2 && s2->attr.proc_pointer && s2->ts.interface) s2 = s2->ts.interface; if (s1 == s2 || !s1 || !s2) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e25cfc8bf0f..b3dba4969d6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2013-01-15 Paul Thomas + + PR fortran/54286 + * gfortran.dg/proc_ptr_result_8.f90 : Add module 'm' to check + case where interface is null. + 2013-01-14 Thomas Koenig PR fortran/55806 diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90 index de6f39f910c..17812bc4422 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90 @@ -2,7 +2,24 @@ ! Test fix for PR54286. ! ! Contributed by Janus Weil +! Module 'm' added later because original fix missed possibility of +! null interfaces - thanks to Dominique Dhumieres ! +module m + type :: foobar + real, pointer :: array(:) + procedure (), pointer, nopass :: f + end type +contains + elemental subroutine fooAssgn (a1, a2) + type(foobar), intent(out) :: a1 + type(foobar), intent(in) :: a2 + allocate (a1%array(size(a2%array))) + a1%array = a2%array + a1%f => a2%f + end subroutine +end module m + implicit integer (a) type :: t procedure(a), pointer, nopass :: p