This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR28172, PR29389, PR29712 & PR30283 - some "one liner fixes"
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: Fortran List <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sun, 14 Jan 2007 23:47:39 +0100
- Subject: [Patch, fortran] PR28172, PR29389, PR29712 & PR30283 - some "one liner fixes"
:ADDPATCH fortran:
The attached fixes the above four PRs; all the fixes are (nearly)
one-liners and are very simply understood from the patch. They are
pretty much the final scrappings from my barrel of fixes or nearly fixes.
Regtested on Cygwin_NT/amd64 - OK for trunk and then in a week or so for
4.2?
Paul
2007-01-14 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.
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/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.
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c (revision 120520)
--- gcc/fortran/trans-stmt.c (working copy)
*************** gfc_trans_call (gfc_code * code, bool de
*** 349,354 ****
--- 349,356 ----
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: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 120520)
--- gcc/fortran/resolve.c (working copy)
*************** pure_function (gfc_expr * e, const char
*** 1501,1506 ****
--- 1501,1511 ----
{
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);
*************** resolve_function (gfc_expr * expr)
*** 1654,1662 ****
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 (arg->expr != NULL
&& arg->expr->rank > 0
--- 1659,1673 ----
for (arg = expr->value.function.actual; arg; arg = arg->next)
{
! 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
*************** resolve_function (gfc_expr * expr)
*** 1723,1728 ****
--- 1734,1750 ----
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: gcc/testsuite/gfortran.dg/altreturn_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/altreturn_4.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/altreturn_4.f90 (revision 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: gcc/testsuite/gfortran.dg/stfunc_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/stfunc_4.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/stfunc_4.f90 (revision 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
Index: gcc/testsuite/gfortran.dg/initialization_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/initialization_1.f90 (revision 120520)
--- gcc/testsuite/gfortran.dg/initialization_1.f90 (working copy)
*************** contains
*** 27,33 ****
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 :: m4(2) = shape (z) ! { dg-warning "Evaluation of nonstandard initialization" }
! This does not depend on non-constant properties.
--- 27,33 ----
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 "Evaluation of nonstandard initialization" }
integer :: m4(2) = shape (z) ! { dg-warning "Evaluation of nonstandard initialization" }
! This does not depend on non-constant properties.
Index: gcc/testsuite/gfortran.dg/bound_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/bound_2.f90 (revision 120520)
--- gcc/testsuite/gfortran.dg/bound_2.f90 (working copy)
*************** contains
*** 194,200 ****
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
end subroutine foo
subroutine jackal (b, c)
--- 194,200 ----
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
end subroutine foo
subroutine jackal (b, c)
Index: gcc/testsuite/gfortran.dg/specification_type_resolution_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/specification_type_resolution_2.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/specification_type_resolution_2.f90 (revision 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" } }