From 93302a249147f4260a9f3ab1c7f9a30a268b42c1 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Mon, 14 Feb 2011 12:59:53 +0100 Subject: [PATCH] re PR fortran/47349 (missing warning: Actual argument contains too few elements) 2011-02-14 Janus Weil PR fortran/47349 * interface.c (get_expr_storage_size): Handle derived-type components. 2011-02-14 Janus Weil PR fortran/47349 * gfortran.dg/argument_checking_18.f90: New. From-SVN: r170125 --- gcc/fortran/ChangeLog | 5 +++ gcc/fortran/interface.c | 10 +++--- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/argument_checking_18.f90 | 34 +++++++++++++++++++ 4 files changed, 48 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/argument_checking_18.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1f63accb159..9bf2eb0af0f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-02-14 Janus Weil + + PR fortran/47349 + * interface.c (get_expr_storage_size): Handle derived-type components. + 2011-02-13 Tobias Burnus PR fortran/47569 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index a03bbebb674..071eed951ed 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1910,7 +1910,7 @@ get_expr_storage_size (gfc_expr *e) else if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT && e->expr_type == EXPR_VARIABLE) { - if (e->symtree->n.sym->as->type == AS_ASSUMED_SHAPE + if (ref->u.ar.as->type == AS_ASSUMED_SHAPE || e->symtree->n.sym->attr.pointer) { elements = 1; @@ -1939,8 +1939,6 @@ get_expr_storage_size (gfc_expr *e) - mpz_get_si (ref->u.ar.as->lower[i]->value.integer)); } } - else - return 0; } if (substrlen) @@ -2130,9 +2128,9 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, actual_size = get_expr_storage_size (a->expr); formal_size = get_sym_storage_size (f->sym); - if (actual_size != 0 - && actual_size < formal_size - && a->expr->ts.type != BT_PROCEDURE) + if (actual_size != 0 && actual_size < formal_size + && a->expr->ts.type != BT_PROCEDURE + && f->sym->attr.flavor != FL_PROCEDURE) { if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where) gfc_warning ("Character length of actual argument shorter " diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fb27e998890..1952af98e58 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-02-14 Janus Weil + + PR fortran/47349 + * gfortran.dg/argument_checking_18.f90: New. + 2011-02-13 Tobias Burnus * gfortran.dg/argument_checking_13.f90: Update dg-error. diff --git a/gcc/testsuite/gfortran.dg/argument_checking_18.f90 b/gcc/testsuite/gfortran.dg/argument_checking_18.f90 new file mode 100644 index 00000000000..dd95b6197b0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/argument_checking_18.f90 @@ -0,0 +1,34 @@ +! { dg-do compile } +! +! PR 47349: missing warning: Actual argument contains too few elements +! +! Contributed by Janus Weil + + implicit none + type t + integer :: j(3) + end type t + + type(t) :: tt + integer :: i(3) = (/ 1,2,3 /) + + tt%j = i + + call sub1 (i) ! { dg-warning "Actual argument contains too few elements" } + call sub1 (tt%j) ! { dg-warning "Actual argument contains too few elements" } + call sub2 (i) ! { dg-error "Rank mismatch in argument" } + call sub2 (tt%j) ! { dg-error "Rank mismatch in argument" } + +contains + + subroutine sub1(i) + integer, dimension(1:3,1:3) :: i + print *,"sub1:",i + end subroutine + + subroutine sub2(i) + integer, dimension(:,:) :: i + print *,"sub2:",i + end subroutine + +end -- 2.30.2