re PR fortran/28172 ([4.2 and 4.1 only] alternate return in contained procedure segfa...
authorPaul Thomas <pault@gcc.gnu.org>
Mon, 15 Jan 2007 08:16:17 +0000 (08:16 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Mon, 15 Jan 2007 08:16:17 +0000 (08:16 +0000)
2007-01-15  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/28172
* trans-stmt.c (gfc_trans_call): If it does not have one, get
a backend_decl for an alternate return.

PR fortran/29389
* resolve.c (pure_function): Statement functions are pure. Note
that this will have to recurse to comply fully with F95.

PR fortran/29712
* resolve.c (resolve_function): Only a reference to the final
dimension of an assumed size array is an error in an inquiry
function.

PR fortran/30283
* resolve.c (resolve_function): Make sure that the function
expression has a type.

2007-01-15  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/28172
* gfortran.dg/altreturn_4.f90: New test.

PR fortran/29389
* gfortran.dg/stfunc_4.f90: New test.

PR fortran/29712
* gfortran.dg/bound_2.f90: Reinstate commented out line.
* gfortran.dg/initialization_1.f90: Change warning.

PR fortran/30283
* gfortran.dg/specification_type_resolution_2.f90: New test.

From-SVN: r120790

gcc/fortran/ChangeLog
gcc/fortran/resolve.c
gcc/fortran/trans-stmt.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/altreturn_4.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/bound_2.f90
gcc/testsuite/gfortran.dg/initialization_1.f90
gcc/testsuite/gfortran.dg/specification_type_resolution_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/stfunc_4.f90 [new file with mode: 0644]

index 5c8567b..d88fa83 100644 (file)
@@ -1,3 +1,22 @@
+2007-01-15  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/28172
+       * trans-stmt.c (gfc_trans_call): If it does not have one, get
+       a backend_decl for an alternate return.
+
+       PR fortran/29389
+       * resolve.c (pure_function): Statement functions are pure. Note
+       that this will have to recurse to comply fully with F95.
+
+       PR fortran/29712
+       * resolve.c (resolve_function): Only a reference to the final
+       dimension of an assumed size array is an error in an inquiry
+       function.
+
+       PR fortran/30283
+       * resolve.c (resolve_function): Make sure that the function
+       expression has a type.
+
 2007-01-14  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/30410
index 05b4dc1..59adf8b 100644 (file)
@@ -1501,6 +1501,11 @@ pure_function (gfc_expr * e, const char **name)
 {
   int pure;
 
+  if (e->symtree != NULL
+        && e->symtree->n.sym != NULL
+        && e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION)
+    return 1;
+
   if (e->value.function.esym)
     {
       pure = gfc_pure (e->value.function.esym);
@@ -1654,9 +1659,15 @@ resolve_function (gfc_expr * expr)
 
       for (arg = expr->value.function.actual; arg; arg = arg->next)
        {
-         if (inquiry && arg->next != NULL && arg->next->expr
-               && arg->next->expr->expr_type != EXPR_CONSTANT)
-           break;
+         if (inquiry && arg->next != NULL && arg->next->expr)
+           {
+             if (arg->next->expr->expr_type != EXPR_CONSTANT)
+               break;
+
+             if ((int)mpz_get_si (arg->next->expr->value.integer)
+                       < arg->expr->rank)
+               break;
+           }
 
          if (arg->expr != NULL
                && arg->expr->rank > 0
@@ -1723,6 +1734,17 @@ resolve_function (gfc_expr * expr)
   if (t == SUCCESS)
     find_noncopying_intrinsics (expr->value.function.esym,
                                expr->value.function.actual);
+
+  /* Make sure that the expression has a typespec that works.  */
+  if (expr->ts.type == BT_UNKNOWN)
+    {
+      if (expr->symtree->n.sym->result
+           && expr->symtree->n.sym->result->ts.type != BT_UNKNOWN)
+       expr->ts = expr->symtree->n.sym->result->ts;
+      else
+       expr->ts = expr->symtree->n.sym->result->ts;
+    }
+
   return t;
 }
 
index 3c14d02..ed37272 100644 (file)
@@ -349,6 +349,8 @@ gfc_trans_call (gfc_code * code, bool dependency_check)
          gcc_assert(select_code->op == EXEC_SELECT);
          sym = select_code->expr->symtree->n.sym;
          se.expr = convert (gfc_typenode_for_spec (&sym->ts), se.expr);
+         if (sym->backend_decl == NULL)
+           sym->backend_decl = gfc_get_symbol_decl (sym);
          gfc_add_modify_expr (&se.pre, sym->backend_decl, se.expr);
        }
       else
index 4e85891..b8cf1a9 100644 (file)
@@ -1,3 +1,18 @@
+2007-01-15  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/28172
+       * gfortran.dg/altreturn_4.f90: New test.
+
+       PR fortran/29389
+       * gfortran.dg/stfunc_4.f90: New test.
+
+       PR fortran/29712
+       * gfortran.dg/bound_2.f90: Reinstate commented out line.
+       * gfortran.dg/initialization_1.f90: Change warning.
+
+       PR fortran/30283
+       * gfortran.dg/specification_type_resolution_2.f90: New test.
+
 2007-01-14  Jan Hubicka  <jh@suse.cz>
 
        * gcc.dg/tree-prof/stringop-1.c: Update pattern for memcpy folding.
diff --git a/gcc/testsuite/gfortran.dg/altreturn_4.f90 b/gcc/testsuite/gfortran.dg/altreturn_4.f90
new file mode 100644 (file)
index 0000000..409ea51
--- /dev/null
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! Tests the fix for PR28172, in which an ICE would result from
+! the contained call with an alternate retrun.
+
+! Contributed by Tobias Schlüter <tobi@gcc.gnu.org>
+
+program blubb
+  call otherini(*998)
+  stop
+998 stop
+contains
+ subroutine init
+   call otherini(*999)
+   return
+999 stop
+ end subroutine init
+end program blubb
index 2fa0c4b..5c4026b 100644 (file)
@@ -194,7 +194,7 @@ contains
   subroutine foo (x,n)
     integer :: x(7,n,2,*), n
 
-    !if (ubound(x,1) /= 7 .or. ubound(x,2) /= 4 .or. ubound(x,3) /= 2) call abort
+    if (ubound(x,1) /= 7 .or. ubound(x,2) /= 4 .or. ubound(x,3) /= 2) call abort
   end subroutine foo
 
   subroutine jackal (b, c)
index af7ccb0..24a1a4f 100644 (file)
@@ -27,7 +27,7 @@ contains
     integer :: l1 = len (ch1)     ! { dg-warning "assumed character length variable" }
 
 ! These are warnings because they are gfortran extensions.
-    integer :: m3 = size (x, 1)   ! { dg-warning "upper bound in the last dimension" }
+    integer :: m3 = size (x, 1)   ! { dg-warning "Evaluation of nonstandard initialization" }
     integer :: m4(2) = shape (z)  ! { dg-warning "Evaluation of nonstandard initialization" }
 
 ! This does not depend on non-constant properties.
diff --git a/gcc/testsuite/gfortran.dg/specification_type_resolution_2.f90 b/gcc/testsuite/gfortran.dg/specification_type_resolution_2.f90
new file mode 100644 (file)
index 0000000..0fcb7bd
--- /dev/null
@@ -0,0 +1,25 @@
+! { dg-do compile }
+! Tests the fix for PR30283 in which the type of the result
+! of bar was getting lost
+
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+module gfcbug50
+  implicit none
+contains
+
+  subroutine foo (n, y)
+    integer, intent(in)         :: n
+    integer, dimension(bar (n)) :: y
+    ! Array bound is specification expression, which is allowed (F2003, sect.7.1.6)
+  end subroutine foo
+
+  pure function bar (n) result (l)
+    integer, intent(in) :: n
+    integer             :: l
+    l = n
+  end function bar
+
+end module gfcbug50
+
+! { dg-final { cleanup-modules "gfcbug50" } }
diff --git a/gcc/testsuite/gfortran.dg/stfunc_4.f90 b/gcc/testsuite/gfortran.dg/stfunc_4.f90
new file mode 100644 (file)
index 0000000..e995fb8
--- /dev/null
@@ -0,0 +1,19 @@
+! { dg-do run }
+! Tests the fix for PR29389, in which the  statement function would not be
+! recognised as PURE within a PURE procedure.
+
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+  INTEGER :: st1, i = 99, a(4), q = 6
+  st1 (i) = i * i * i 
+  FORALL(i=1:4) a(i) = st1 (i) 
+  FORALL(i=1:4) a(i) = u (a(i)) - a(i)** 2 
+  if (any (a .ne. 0)) call abort ()
+  if (i .ne. 99) call abort ()
+contains
+  pure integer function u (x)
+    integer,intent(in) :: x
+    st2 (i) = i * i
+    u = st2(x)
+  end function
+end