diff options
| -rw-r--r-- | gcc/fortran/expr.cc | 2 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/ptr-func-5.f90 | 39 |
2 files changed, 40 insertions, 1 deletions
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index d91722e..09a16c9 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -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" diff --git a/gcc/testsuite/gfortran.dg/ptr-func-5.f90 b/gcc/testsuite/gfortran.dg/ptr-func-5.f90 new file mode 100644 index 0000000..05fd567 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ptr-func-5.f90 @@ -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 |