:ADDPATCH:
This patch consists of five patchlets, all of which are
straightforward and
self-explanatory.
Regtested on FC5/Athlon1700 - OK for trunk and 4.1?
Paul
2006-06-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25056
* interface.c (compare_actual_formal): Signal an error if the formal
argument is a pure procedure and the actual is not pure.
PR fortran/27554
* resolve.c (resolve_actual_arglist): If the type of procedure
passed as an actual argument is not already declared, see if it is
an intrinsic.
PR fortran/25073
* resolve.c (resolve_select): Use bits 1 and 2 of a new int to
keep track of the appearance of constant logical case expressions.
Signal an error is either value appears more than once.
PR fortran/20874
* resolve.c (resolve_fl_procedure): Signal an error if an elemental
function is not scalar valued.
PR fortran/20867
* match.c (recursive_stmt_fcn): Perform implicit typing of variables.
2006-06-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/20867
* gfortran.dg/stfunc_3.f90: New test.
PR fortran/25056
* gfortran.dg/impure_actual_1.f90: New test.
PR fortran/20874
* gfortran.dg/elemental_result_1.f90: New test.
PR fortran/25073
* gfortran.dg/select_7.f90: New test.
PR fortran/27554
* intrinsic_actual_1.f: New test.
------------------------------------------------------------------------
Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c (revision 114823)
--- gcc/fortran/interface.c (working copy)
*************** compare_actual_formal (gfc_actual_arglis
*** 1296,1301 ****
--- 1296,1312 ----
}
}
+ if (f->sym->attr.flavor == FL_PROCEDURE
+ && f->sym->attr.pure
+ && a->expr->ts.type == BT_PROCEDURE
+ && !a->expr->symtree->n.sym->attr.pure)
+ {
+ if (where)
+ gfc_error ("Expected a PURE procedure for argument '%s' at %L",
+ f->sym->name, &a->expr->where);
+ return 0;
+ }
+
if (f->sym->as
&& f->sym->as->type == AS_ASSUMED_SHAPE
&& a->expr->expr_type == EXPR_VARIABLE
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 114823)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_actual_arglist (gfc_actual_argli
*** 829,834 ****
--- 829,842 ----
|| sym->attr.external)
{
+ /* If a procedure is not already determined to be something else
+ check if it is intrinsic. */
+ if (!sym->attr.intrinsic
+ && !(sym->attr.external || sym->attr.use_assoc
+ || sym->attr.if_source == IFSRC_IFBODY)
+ && gfc_intrinsic_name (sym->name, sym->attr.subroutine))
+ sym->attr.intrinsic = 1;
+
if (sym->attr.proc == PROC_ST_FUNCTION)
{
gfc_error ("Statement function '%s' at %L is not allowed as an "
*************** resolve_select (gfc_code * code)
*** 3615,3620 ****
--- 3623,3629 ----
gfc_expr *case_expr;
gfc_case *cp, *default_case, *tail, *head;
int seen_unreachable;
+ int seen_logical;
int ncases;
bt type;
try t;
*************** resolve_select (gfc_code * code)
*** 3697,3702 ****
--- 3706,3712 ----
default_case = NULL;
head = tail = NULL;
ncases = 0;
+ seen_logical = 0;
for (body = code->block; body; body = body->block)
{
*************** resolve_select (gfc_code * code)
*** 3749,3754 ****
--- 3759,3777 ----
break;
}
+ if (type == BT_LOGICAL && cp->low->expr_type == EXPR_CONSTANT)
+ {
+ if (cp->low->value.logical & seen_logical)
+ {
+ gfc_error ("constant logical value in CASE statement "
+ "is repeated at %L",
+ &cp->low->where);
+ t = FAILURE;
+ break;
+ }
+ seen_logical |= cp->low->value.logical == 0 ? 2 : 1;
+ }
+
if (cp->low != NULL && cp->high != NULL
&& cp->low != cp->high
&& gfc_compare_expr (cp->low, cp->high) > 0)
*************** resolve_fl_procedure (gfc_symbol *sym, i
*** 5177,5182 ****
--- 5200,5215 ----
return FAILURE;
}
+ /* An elemental function is required to return a scalar 12.7.1 */
+ if (sym->attr.elemental && sym->attr.function && sym->as)
+ {
+ gfc_error ("ELEMENTAL function '%s' at %L must have a scalar "
+ "result", sym->name, &sym->declared_at);
+ /* Reset so that the error only occurs once. */
+ sym->attr.elemental = 0;
+ return FAILURE;
+ }
+
/* 5.1.1.5 of the Standard: A function name declared with an asterisk
char-len-param shall not be array-valued, pointer-valued, recursive
or pure. ....snip... A character value of * may only be used in the
Index: gcc/fortran/match.c
===================================================================
*** gcc/fortran/match.c (revision 114823)
--- gcc/fortran/match.c (working copy)
*************** cleanup:
*** 2796,2802 ****
/* Check that a statement function is not recursive. This is done by looking
for the statement function symbol(sym) by looking recursively through its
! expression(e). If a reference to sym is found, true is returned. */
static bool
recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
{
--- 2796,2806 ----
/* Check that a statement function is not recursive. This is done by looking
for the statement function symbol(sym) by looking recursively through its
! expression(e). If a reference to sym is found, true is returned.
! 12.5.4 requires that any variable of function that is implicitly typed
! shall have that type confirmed by any subsequent type declaration. The
! implicit typing is conveniently done here. */
!
static bool
recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
{
*************** recursive_stmt_fcn (gfc_expr *e, gfc_sym
*** 2830,2840 ****
--- 2834,2850 ----
&& recursive_stmt_fcn (e->symtree->n.sym->value, sym))
return true;
+ if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
+ gfc_set_default_type (e->symtree->n.sym, 0, NULL);
+
break;
case EXPR_VARIABLE:
if (e->symtree && sym->name == e->symtree->n.sym->name)
return true;
+
+ if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
+ gfc_set_default_type (e->symtree->n.sym, 0, NULL);
break;
case EXPR_OP:
Index: gcc/testsuite/gfortran.dg/stfunc_3.f90
===================================================================
*** gcc/testsuite/gfortran.dg/stfunc_3.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/stfunc_3.f90 (revision 0)
***************
*** 0 ****
--- 1,13 ----
+ ! { dg-do compile }
+ ! Tests the fix for PR20867 in which implicit typing was not done within
+ ! statement functions and so was not confirmed or not by subsequent
+ ! type delarations.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ REAL :: st1
+ st1(I)=I**2
+ REAL :: I ! { dg-error " already has basic type of INTEGER" }
+ END
+
+
Index: gcc/testsuite/gfortran.dg/impure_actual_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/impure_actual_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/impure_actual_1.f90 (revision 0)
***************
*** 0 ****
--- 1,25 ----
+ ! { dg-do compile }
+ ! Tests the fix for PR25056 in which a non-PURE procedure could be
+ ! passed as the actual argument to a PURE procedure.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ MODULE M1
+ CONTAINS
+ FUNCTION L()
+ L=1
+ END FUNCTION L
+ PURE FUNCTION J(K)
+ INTERFACE
+ PURE FUNCTION K()
+ END FUNCTION K
+ END INTERFACE
+ J=K()
+ END FUNCTION J
+ END MODULE M1
+ USE M1
+ write(6,*) J(L) ! { dg-error "Expected a PURE procedure for argument" }
+ END
+
+ ! { dg-final { cleanup-modules "M1" } }
+
Index: gcc/testsuite/gfortran.dg/elemental_result_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/elemental_result_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/elemental_result_1.f90 (revision 0)
***************
*** 0 ****
--- 1,21 ----
+ ! { dg-do compile }
+ ! Tests the fix for PR20874 in which array valued elemental
+ ! functions were permitted.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ MODULE Test
+ CONTAINS
+ ELEMENTAL FUNCTION LL(I) ! { dg-error "must have a scalar result" }
+ INTEGER, INTENT(IN) :: I
+ INTEGER :: LL(2)
+ END FUNCTION LL
+ !
+ ! This was already OK.
+ !
+ ELEMENTAL FUNCTION MM(I)
+ INTEGER, INTENT(IN) :: I
+ INTEGER, pointer :: MM ! { dg-error "conflicts with ELEMENTAL" }
+ END FUNCTION MM
+ END MODULE Test
+
Index: gcc/testsuite/gfortran.dg/select_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/select_7.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/select_7.f90 (revision 0)
***************
*** 0 ****
--- 1,13 ----
+ ! { dg-do compile }
+ ! Tests the fix for PR25073 in which overlap in logical case
+ ! expressions was permitted.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ LOGICAL :: L
+ SELECT CASE(L)
+ CASE(.true.)
+ CASE(.false.)
+ CASE(.true.) ! { dg-error "value in CASE statement is repeated" }
+ END SELECT
+ END
Index: gcc/testsuite/gfortran.dg/intrinsic_actual_1.f
===================================================================
*** gcc/testsuite/gfortran.dg/intrinsic_actual_1.f (revision 0)
--- gcc/testsuite/gfortran.dg/intrinsic_actual_1.f (revision 0)
***************
*** 0 ****
--- 1,49 ----
+ ! { dg-do compile }
+ ! Tests the fix for PR27554, where the actual argument reference
+ ! to abs would not be recognised as being to an intrinsic
+ ! procedure and would produce junk in the assembler.
+ !
+ ! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+ !
+ subroutine foo (proc, z)
+ external proc
+ real proc, z
+ if ((proc(z) .ne. abs (z)) .and.
+ & (proc(z) .ne. alog10 (abs(z)))) call abort ()
+ return
+ end
+
+ external cos
+ interface
+ function sin (a)
+ real a, sin
+ end function sin
+ end interface
+
+
+ intrinsic alog10
+ real x
+ x = 100.
+ ! The reference here would prevent the actual arg from being seen
+ ! as an intrinsic procedure in the call to foo.
+ x = -abs(x)
+ call foo(abs, x)
+ ! The intrinsic function can be locally over-ridden by an interface
+ call foo(sin, x)
+ ! or an external declaration.
+ call foo(cos, x)
+ ! Just make sure with another intrinsic but this time not referenced.
+ call foo(alog10, -x)
+ end
+
+ function sin (a)
+ real a, sin
+ sin = -a
+ return
+ end
+
+ function cos (a)
+ real a, cos
+ cos = -a
+ return
+ end
------------------------------------------------------------------------
2006-06-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/25056
* interface.c (compare_actual_formal): Signal an error if the formal
argument is a pure procedure and the actual is not pure.
PR fortran/27554
* resolve.c (resolve_actual_arglist): If the type of procedure
passed as an actual argument is not already declared, see if it is
an intrinsic.
PR fortran/25073
* resolve.c (resolve_select): Use bits 1 and 2 of a new int to
keep track of the appearance of constant logical case expressions.
Signal an error is either value appears more than once.
PR fortran/20874
* resolve.c (resolve_fl_procedure): Signal an error if an elemental
function is not scalar valued.
PR fortran/20867
* match.c (recursive_stmt_fcn): Perform implicit typing of variables.
2006-06-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/20867
* gfortran.dg/stfunc_3.f90: New test.
PR fortran/25056
* gfortran.dg/impure_actual_1.f90: New test.
PR fortran/20874
* gfortran.dg/elemental_result_1.f90: New test.
PR fortran/25073
* gfortran.dg/select_7.f90: New test.
PR fortran/27554
* intrinsic_actual_1.f: New test.