+2016-11-09 Steve Kargl <kargl@gcc.gnu.org>
+ Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/60777
+ * expr.c (external_spec_function): Allow recursive specification
+ functions in F03.
+
2016-11-09 Paul Thomas <pault@gcc.gnu.org>
* check.c (gfc_check_move_alloc): Prevent error that avoids
return false;
}
- if (f->attr.recursive)
- {
- gfc_error ("Specification function %qs at %L cannot be RECURSIVE",
- f->name, &e->where);
+ /* F08:7.1.11.6. */
+ if (f->attr.recursive
+ && !gfc_notify_std (GFC_STD_F2003,
+ "Specification function '%s' "
+ "at %L cannot be RECURSIVE", f->name, &e->where))
return false;
- }
function_allowed:
return restricted_args (e->value.function.actual);
+2016-11-09 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/60777
+ * gfortran.dg/spec_expr_7.f90: New test.
+
2016-11-09 Jakub Jelinek <jakub@redhat.com>
PR target/77718
--- /dev/null
+! { dg-do run }
+!
+! PR 60777: [F03] RECURSIVE function rejected in specification expression
+!
+! Contributed by Vladimir Fuka <vladimir.fuka@gmail.com>
+
+module recur
+ implicit none
+contains
+
+ pure recursive function f(n) result(answer)
+ integer, intent(in) :: n
+ integer :: answer
+ if (n<2) then
+ answer = 1
+ else
+ answer = f(n-1)*n
+ end if
+ end function
+
+ pure function usef(n)
+ integer,intent(in) :: n
+ character(f(n)) :: usef
+ usef = repeat('*',f(n))
+ end function
+end module
+
+program testspecexpr
+ use recur
+ implicit none
+ if (usef(1) /= '*') call abort()
+ if (usef(2) /= '**') call abort()
+ if (usef(3) /= '******') call abort()
+end