Fortran: CLASS pointer function result in variable definition context [PR109846]
gcc/fortran/ChangeLog: PR fortran/109846 * expr.cc (gfc_check_vardef_context): Check appropriate pointer attribute for CLASS vs. non-CLASS function result in variable definition context. gcc/testsuite/ChangeLog: PR fortran/109846 * gfortran.dg/ptr-func-5.f90: New test. (cherry picked from commit fa0569e90efe8a5cb895a3f50dd502f849940828)
This commit is contained in:
parent
611be07e48
commit
f48c546902
@ -6256,7 +6256,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
|
||||
&& !(sym->attr.flavor == FL_PROCEDURE && sym == sym->result)
|
||||
&& !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer)
|
||||
&& !(sym->attr.flavor == FL_PROCEDURE
|
||||
&& sym->attr.function && sym->attr.pointer))
|
||||
&& sym->attr.function && attr.pointer))
|
||||
{
|
||||
if (context)
|
||||
gfc_error ("%qs in variable definition context (%s) at %L is not"
|
||||
|
39
gcc/testsuite/gfortran.dg/ptr-func-5.f90
Normal file
39
gcc/testsuite/gfortran.dg/ptr-func-5.f90
Normal file
@ -0,0 +1,39 @@
|
||||
! { dg-do compile }
|
||||
! PR fortran/109846
|
||||
! CLASS pointer function result in variable definition context
|
||||
|
||||
module foo
|
||||
implicit none
|
||||
type :: parameter_list
|
||||
contains
|
||||
procedure :: sublist, sublist_nores
|
||||
end type
|
||||
contains
|
||||
function sublist (this) result (slist)
|
||||
class(parameter_list), intent(inout) :: this
|
||||
class(parameter_list), pointer :: slist
|
||||
allocate (slist)
|
||||
end function
|
||||
function sublist_nores (this)
|
||||
class(parameter_list), intent(inout) :: this
|
||||
class(parameter_list), pointer :: sublist_nores
|
||||
allocate (sublist_nores)
|
||||
end function
|
||||
end module
|
||||
|
||||
program example
|
||||
use foo
|
||||
implicit none
|
||||
type(parameter_list) :: plist
|
||||
call sub1 (plist%sublist())
|
||||
call sub1 (plist%sublist_nores())
|
||||
call sub2 (plist%sublist())
|
||||
call sub2 (plist%sublist_nores())
|
||||
contains
|
||||
subroutine sub1 (plist)
|
||||
type(parameter_list), intent(inout) :: plist
|
||||
end subroutine
|
||||
subroutine sub2 (plist)
|
||||
type(parameter_list) :: plist
|
||||
end subroutine
|
||||
end program
|
Loading…
x
Reference in New Issue
Block a user