re PR fortran/47349 (missing warning: Actual argument contains too few elements)

2011-02-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47349
	* interface.c (get_expr_storage_size): Handle derived-type components.

2011-02-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47349
	* gfortran.dg/argument_checking_18.f90: New.

From-SVN: r170125

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1f63acc..9bf2eb0 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2011-02-14  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/47349
+       * interface.c (get_expr_storage_size): Handle derived-type components.
+
 2011-02-13  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/47569

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index a03bbeb..071eed9 100644 (file)
--- 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 fb27e99..1952af9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-02-14  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/47349
+       * gfortran.dg/argument_checking_18.f90: New.
+
 2011-02-13  Tobias Burnus  <burnus@net-b.de>
 
        * 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 (file)
index 0000000..dd95b61
--- /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 <janus@gcc.gnu.org>
+
+ 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