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

gcc/fortran/ChangeLog

+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

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 "

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/argument_checking_18.f90

+! { 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