re PR fortran/31564 (Error: Type/rank mismatch in argument)

2007-09-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31564
	* primary.c (gfc_match_rvalue): Make expressions that refer
	to derived type parameters that have array references into
	variable expressions.  Remove references to use association
	from the symbol.

	PR fortran/33241
	* decl.c (add_init_expr_to_sym): Provide assumed character
	length parameters with the length of the initialization
	expression, if a constant, or that of the first element of
	an array.

2007-09-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31564
	* gfortran.dg/derived_comp_array_ref_2.f90: New test.

	PR fortran/33241
	* gfortran.dg/char_length_10.f90: New test.

From-SVN: r128130

6 files changed, 118 insertions, 3 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6ac59b6..e1d6ecf 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2007-09-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31564
+	* primary.c (gfc_match_rvalue): Make expressions that refer
+	to derived type parameters that have array references into
+	variable expressions.  Remove references to use association
+	from the symbol.
+
+	PR fortran/33241
+	* decl.c (add_init_expr_to_sym): Provide assumed character
+	length parameters with the length of the initialization
+	expression, if a constant, or that of the first element of
+	an array.
+
 2007-09-04  Janus Weil  <jaydub66@gmail.com>
 	    Paul Thomas  <pault@gcc.gnu.org>
 
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 470cbfa..f9f92ad 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1173,15 +1173,30 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
 	  /* Update symbol character length according initializer.  */
 	  if (sym->ts.cl->length == NULL)
 	    {
+	      int clen;
 	      /* If there are multiple CHARACTER variables declared on the
 		 same line, we don't want them to share the same length.  */
 	      sym->ts.cl = gfc_get_charlen ();
 	      sym->ts.cl->next = gfc_current_ns->cl_list;
 	      gfc_current_ns->cl_list = sym->ts.cl;
 
-	      if (sym->attr.flavor == FL_PARAMETER
-		  && init->expr_type == EXPR_ARRAY)
-		sym->ts.cl->length = gfc_copy_expr (init->ts.cl->length);
+	      if (sym->attr.flavor == FL_PARAMETER)
+		{
+		  if (init->expr_type == EXPR_CONSTANT)
+		    {
+		      clen = init->value.character.length;
+		      sym->ts.cl->length = gfc_int_expr (clen);
+		    }
+		  else if (init->expr_type == EXPR_ARRAY)
+		    {
+		      gfc_expr *p = init->value.constructor->expr;
+		      clen = p->value.character.length;
+		      sym->ts.cl->length = gfc_int_expr (clen);
+		    }
+		  else if (init->ts.cl && init->ts.cl->length)
+		    sym->ts.cl->length =
+				gfc_copy_expr (sym->value->ts.cl->length);
+		}
 	    }
 	  /* Update initializer character length according symbol.  */
 	  else if (sym->ts.cl->length->expr_type == EXPR_CONSTANT)
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 2be27d7..f622996 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2046,6 +2046,7 @@ gfc_match_rvalue (gfc_expr **result)
   int i;
   gfc_typespec *ts;
   bool implicit_char;
+  gfc_ref *ref;
 
   m = gfc_match_name (name);
   if (m != MATCH_YES)
@@ -2143,6 +2144,34 @@ gfc_match_rvalue (gfc_expr **result)
 
       e->symtree = symtree;
       m = match_varspec (e, 0);
+
+      if (sym->ts.is_c_interop || sym->ts.is_iso_c)
+	break;
+
+      /* Variable array references to derived type parameters cause
+	 all sorts of headaches in simplification.  Make them variable
+	 and scrub any module identity because they do not appear to
+	 be referencable from the module.  */  
+      if (sym->value && sym->ts.type == BT_DERIVED && e->ref)
+	{
+	  for (ref = e->ref; ref; ref = ref->next)
+	    if (ref->type == REF_ARRAY)
+	      break;
+
+	  if (ref == NULL)
+	    break;
+
+	  ref = e->ref;
+	  e->ref = NULL;
+	  gfc_free_expr (e);
+	  e = gfc_get_expr ();
+	  e->expr_type = EXPR_VARIABLE;
+	  e->symtree = symtree;
+	  e->ref = ref;
+	  sym->attr.use_assoc = 0;
+	  sym->module = NULL;
+	}
+
       break;
 
     case FL_DERIVED:
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index aa4306b..c6ba699 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2007-09-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31564
+	* gfortran.dg/derived_comp_array_ref_2.f90: New test.
+
+	PR fortran/33241
+	* gfortran.dg/char_length_10.f90: New test.
+
 2007-09-05  Paolo Carlini  <pcarlini@suse.de>
 
 	PR c++/29731
diff --git a/gcc/testsuite/gfortran.dg/char_length_10.f90 b/gcc/testsuite/gfortran.dg/char_length_10.f90
new file mode 100644
index 0000000..23bb37f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_length_10.f90
@@ -0,0 +1,17 @@
+{ dg-do compile }
+! Checks the fix for PR33241, in which the assumed character
+! length of the parameter was never filled in with that of
+! the initializer.
+!
+! Contributed by Victor Prosolin <victor.prosolin@gmail.com>
+!
+PROGRAM fptest

+  IMPLICIT NONE

+  CHARACTER (LEN=*), DIMENSION(1),  PARAMETER :: var  = 'a'

+  CALL parsef (var)

+contains

+  SUBROUTINE parsef (Var)

+    IMPLICIT NONE

+    CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var

+  END SUBROUTINE parsef

+END PROGRAM fptest

diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90
new file mode 100644
index 0000000..0530b0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! Tests the fix for PR31564, in which the actual argument to
+! the call for set_bound was simplified when it should not be.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+MODULE cdf_aux_mod

+  TYPE :: the_distribution

+    INTEGER :: parameters(2)

+  END TYPE the_distribution

+  TYPE (the_distribution), PARAMETER :: the_beta = the_distribution((/99,999/))
+CONTAINS

+  SUBROUTINE set_bound(arg_name, test)

+    INTEGER, INTENT (IN) :: arg_name, test
+    if (arg_name .ne. test) call abort ()

+  END SUBROUTINE set_bound

+END MODULE cdf_aux_mod
+

+MODULE cdf_beta_mod

+CONTAINS

+  SUBROUTINE cdf_beta(which, test)

+    USE cdf_aux_mod

+    INTEGER :: which, test

+    CALL set_bound(the_beta%parameters(which), test)

+  END SUBROUTINE cdf_beta

+END MODULE cdf_beta_mod
+

+  use cdf_beta_mod
+  call cdf_beta (1, 99)
+  call cdf_beta (2, 999)
+end
+! { dg-final { cleanup-modules "cdf_aux_mod cdf_beta_mod" } }