I've committed the attached patch. Read the test case
for an explanation.
2019-06-21 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/67884
* resolve.c (deferred_requirements) : Check only the result variable.
(resolve_fl_procedure): Check deferred requirements on functions.
2019-06-21 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/67884
* gfortran.dg/dummy_procedure_8.f90: Remove a test that is ...
* gfortran.dg/pr67884.f90: ... covered here. New test.
--
Steve
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 272555)
+++ gcc/fortran/resolve.c (working copy)
@@ -12388,6 +12388,10 @@ deferred_requirements (gfc_symbol *sym)
|| sym->attr.associate_var
|| sym->attr.omp_udr_artificial_var))
{
+ /* If a function has a result variable, only check the variable. */
+ if (sym->result && sym->name != sym->result->name)
+ return true;
+
gfc_error ("Entity %qs at %L has a deferred type parameter and "
"requires either the POINTER or ALLOCATABLE attribute",
sym->name, &sym->declared_at);
@@ -12596,6 +12600,10 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
if (sym->attr.function
&& !resolve_fl_var_and_proc (sym, mp_flag))
+ return false;
+
+ /* Constraints on deferred type parameter. */
+ if (!deferred_requirements (sym))
return false;
if (sym->ts.type == BT_CHARACTER)
Index: gcc/testsuite/gfortran.dg/dummy_procedure_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/dummy_procedure_8.f90 (revision 272555)
+++ gcc/testsuite/gfortran.dg/dummy_procedure_8.f90 (working copy)
@@ -7,7 +7,6 @@
implicit none
call call_a(a1) ! { dg-error "Character length mismatch in function result" }
-call call_a(a2) ! { dg-error "Character length mismatch in function result" }
call call_b(b1) ! { dg-error "Shape mismatch" }
call call_c(c1) ! { dg-error "POINTER attribute mismatch in function result" }
call call_d(c1) ! { dg-error "ALLOCATABLE attribute mismatch in function result" }
@@ -17,9 +16,6 @@ call call_f(c1) ! { dg-error "PROCEDURE POINTER misma
contains
character(1) function a1()
- end function
-
- character(:) function a2()
end function
subroutine call_a(a3)
Index: gcc/testsuite/gfortran.dg/pr67884.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr67884.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr67884.f90 (working copy)
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! PR fortran/67884
+! Original code contribute by Gerhard Steinmetz
+program p
+ integer i
+ print *, [(f(i), i=1,3)]
+ print *, [(g(i), i=1,3)]
+ contains
+ function f(n) ! { dg-error "has a deferred type parameter" }
+ integer :: n
+ character(:) :: f
+ character(3) :: c = 'abc'
+ f = c(n:n)
+ end
+ function g(n) result(z) ! { dg-error "has a deferred type parameter" }
+ integer :: n
+ character(:) :: z
+ character(3) :: c = 'abc'
+ z = c(n:n)
+ end
+end program p
