diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2023-05-14 21:53:51 +0200 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2023-05-15 19:27:25 +0200 |
| commit | fa0569e90efe8a5cb895a3f50dd502f849940828 (patch) | |
| tree | fa47f9aff520389a606bc0f546c65995c965e51a /gcc | |
| parent | 76e11280e79c5dd5089c17d5726cae9a5a21bc2e (diff) | |
| download | gcc-fa0569e90efe8a5cb895a3f50dd502f849940828.zip gcc-fa0569e90efe8a5cb895a3f50dd502f849940828.tar.gz gcc-fa0569e90efe8a5cb895a3f50dd502f849940828.tar.bz2 | |
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.
Diffstat (limited to 'gcc')
| -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 |