[multiple changes]
authorJanus Weil <janus@gcc.gnu.org>
Wed, 9 Nov 2016 17:22:02 +0000 (18:22 +0100)
committerJanus Weil <janus@gcc.gnu.org>
Wed, 9 Nov 2016 17:22:02 +0000 (18:22 +0100)
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  Janus Weil  <janus@gcc.gnu.org>

PR fortran/60777
* gfortran.dg/spec_expr_7.f90: New test.

From-SVN: r242009

gcc/fortran/ChangeLog
gcc/fortran/expr.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/spec_expr_7.f90 [new file with mode: 0644]

index bb0beb713e999201ae5496d600f56bfb2e7cace8..615ade012f7911f69c170ad4d341084207d05806 100644 (file)
@@ -1,3 +1,10 @@
+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
index b2ffaae246a69bf39d93c6cd5a8116a205d1d8d8..e2d1311d1a5838e35a95b8f0fc020570954db314 100644 (file)
@@ -2794,12 +2794,12 @@ external_spec_function (gfc_expr *e)
       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);
index 7a3b6c5ffc608e4619c970e4b93ea72294156f06..749c7d6bef0672e6fa58fabef247dfb3fe9d477b 100644 (file)
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/spec_expr_7.f90 b/gcc/testsuite/gfortran.dg/spec_expr_7.f90
new file mode 100644 (file)
index 0000000..0680d12
--- /dev/null
@@ -0,0 +1,34 @@
+! { 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