From: Steven G. Kargl Date: Sun, 6 Aug 2006 01:38:46 +0000 (+0000) Subject: re PR fortran/28548 ([4.1 only] Optional argument failed) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=994c1cc04dda157794990bbe71412678e3d7fad8;p=gcc.git re PR fortran/28548 ([4.1 only] Optional argument failed) 2006-08-05 Steven G. Kargl PR fortran/28548 * gfortran.dg/elemental_optional_args_1.f90: dg-error becomes dg-warning. Add -pedantic option. * resolve.c(resolve_elemental_actual): Add flags.h to use -pedantic and exclude conversion functions in conditional. Change gfc_error to gfc_warning. (warn_unused_label) Rename to ... (warn_unused_fortran_label) avoid warn_unused_label in flags.h. From-SVN: r115963 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bb84735d21a..7be47e2ea69 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2006-08-05 Steven G. Kargl + + PR fortran/28548 + * resolve.c(resolve_elemental_actual): Add flags.h to use -pedantic + and exclude conversion functions in conditional. Change gfc_error + to gfc_warning. + (warn_unused_label) Rename to ... + (warn_unused_fortran_label) avoid warn_unused_label in flags.h. + 2006-07-30 Francois-Xavier Coudert * intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index aee04eccd6c..c327a82c9d0 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -23,6 +23,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor,Boston, MA #include "config.h" #include "system.h" +#include "flags.h" #include "gfortran.h" #include "arith.h" /* For gfc_compare_expr(). */ #include "dependency.h" @@ -1007,18 +1008,19 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c) else if (isym) formal_optional = true; - if (arg->expr != NULL + if (pedantic && arg->expr != NULL && arg->expr->expr_type == EXPR_VARIABLE && arg->expr->symtree->n.sym->attr.optional && formal_optional && arg->expr->rank - && (set_by_optional || arg->expr->rank != rank)) + && (set_by_optional || arg->expr->rank != rank) + && !(isym && isym->generic_id == GFC_ISYM_CONVERSION)) { - gfc_error ("'%s' at %L is an array and OPTIONAL; it cannot " - "therefore be an actual argument of an ELEMENTAL " - "procedure unless there is a non-optional argument " - "with the same rank (12.4.1.5)", - arg->expr->symtree->n.sym->name, &arg->expr->where); + gfc_warning ("'%s' at %L is an array and OPTIONAL; IF IT IS " + "MISSING, it cannot be the actual argument of an " + "ELEMENTAL procedure unless there is a non-optional" + "argument with the same rank (12.4.1.5)", + arg->expr->symtree->n.sym->name, &arg->expr->where); return FAILURE; } } @@ -6100,12 +6102,12 @@ gfc_elemental (gfc_symbol * sym) /* Warn about unused labels. */ static void -warn_unused_label (gfc_st_label * label) +warn_unused_fortran_label (gfc_st_label * label) { if (label == NULL) return; - warn_unused_label (label->left); + warn_unused_fortran_label (label->left); if (label->defined == ST_LABEL_UNKNOWN) return; @@ -6126,7 +6128,7 @@ warn_unused_label (gfc_st_label * label) break; } - warn_unused_label (label->right); + warn_unused_fortran_label (label->right); } @@ -6649,7 +6651,7 @@ resolve_types (gfc_namespace * ns) /* Warn about unused labels. */ if (gfc_option.warn_unused_labels) - warn_unused_label (ns->st_labels); + warn_unused_fortran_label (ns->st_labels); gfc_resolve_uops (ns->uop_root); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0cdbbefb009..7aa23eb3e22 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2006-08-05 Steven G. Kargl + + PR fortran/28548 + * gfortran.dg/elemental_optional_args_1.f90: dg-error becomes + dg-warning. Add -pedantic option. + 2006-08-05 Volker Reichelt PR c/28502 diff --git a/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90 b/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90 index 258b6b0f76a..4f274baa20b 100644 --- a/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90 +++ b/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90 @@ -1,4 +1,5 @@ ! { dg-do compile } +! { dg-options "-pedantic" } ! Check the fix for PR20893, in which actual arguments could violate: ! "(5) If it is an array, it shall not be supplied as an actual argument to ! an elemental procedure unless an array of the same rank is supplied as an @@ -21,19 +22,19 @@ CONTAINS end interface ! check an intrinsic function - write(6,*) MAX(A1,A2,A3) ! { dg-error "array and OPTIONAL" } + write(6,*) MAX(A1,A2,A3) ! { dg-warning "array and OPTIONAL" } write(6,*) MAX(A1,A3,A2) write(6,*) MAX(A1,A4,A3) ! check an internal elemental function - write(6,*) foo(A1,A2,A3) ! { dg-error "array and OPTIONAL" } + write(6,*) foo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" } write(6,*) foo(A1,A3,A2) write(6,*) foo(A1,A4,A3) ! check an external elemental function - write(6,*) efoo(A1,A2,A3) ! { dg-error "array and OPTIONAL" } + write(6,*) efoo(A1,A2,A3) ! { dg-warning "array and OPTIONAL" } write(6,*) efoo(A1,A3,A2) write(6,*) efoo(A1,A4,A3) ! check an elemental subroutine - call foobar (A1,A2,A3) ! { dg-error "array and OPTIONAL" } + call foobar (A1,A2,A3) ! { dg-warning "array and OPTIONAL" } call foobar (A1,A2,A4) call foobar (A1,A4,A4) END SUBROUTINE @@ -49,4 +50,5 @@ CONTAINS B1 = 1 end subroutine foobar -END \ No newline at end of file +END +