[Patch, fortran] PR25056, PR27554, PR25073, PR20874 & PR20867
Paul Thomas
paulthomas2@wanadoo.fr
Fri Jun 23 17:49:00 GMT 2006
Dang it - I knew that I would forget something!
Paul
> :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.
>
More information about the Gcc-patches
mailing list