From 9ebe2d22e7201bca8e75111ec66ccae8454896ae Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 15 Jan 2007 08:16:17 +0000 Subject: [PATCH] re PR fortran/28172 ([4.2 and 4.1 only] alternate return in contained procedure segfaults) 2007-01-15 Paul Thomas 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 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 | 19 +++++++++++++++ gcc/fortran/resolve.c | 28 +++++++++++++++++++--- gcc/fortran/trans-stmt.c | 2 ++ gcc/testsuite/ChangeLog | 15 ++++++++++++ gcc/testsuite/gfortran.dg/altreturn_4.f90 | 17 +++++++++++++ gcc/testsuite/gfortran.dg/bound_2.f90 | 2 +- gcc/testsuite/gfortran.dg/initialization_1.f90 | 2 +- .../specification_type_resolution_2.f90 | 25 +++++++++++++++++++ gcc/testsuite/gfortran.dg/stfunc_4.f90 | 19 +++++++++++++++ 9 files changed, 124 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/altreturn_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/specification_type_resolution_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/stfunc_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5c8567b..d88fa83 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,22 @@ +2007-01-15 Paul Thomas + + 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 PR fortran/30410 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 05b4dc1..59adf8b 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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; } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 3c14d02..ed37272 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4e85891..b8cf1a9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,18 @@ +2007-01-15 Paul Thomas + + 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 * 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 index 0000000..409ea51 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/altreturn_4.f90 @@ -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 + +program blubb + call otherini(*998) + stop +998 stop +contains + subroutine init + call otherini(*999) + return +999 stop + end subroutine init +end program blubb diff --git a/gcc/testsuite/gfortran.dg/bound_2.f90 b/gcc/testsuite/gfortran.dg/bound_2.f90 index 2fa0c4b..5c4026b 100644 --- a/gcc/testsuite/gfortran.dg/bound_2.f90 +++ b/gcc/testsuite/gfortran.dg/bound_2.f90 @@ -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) diff --git a/gcc/testsuite/gfortran.dg/initialization_1.f90 b/gcc/testsuite/gfortran.dg/initialization_1.f90 index af7ccb0..24a1a4f 100644 --- a/gcc/testsuite/gfortran.dg/initialization_1.f90 +++ b/gcc/testsuite/gfortran.dg/initialization_1.f90 @@ -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 index 0000000..0fcb7bd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/specification_type_resolution_2.f90 @@ -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 + +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 index 0000000..e995fb8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/stfunc_4.f90 @@ -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 + + 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 -- 2.7.4