re PR fortran/34784 (implicit character(s) hides type of selected_int_kind intrinsic)

2008-01-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34784
	* array.c (gfc_check_constructor_type): Clear the expression ts
	so that the checking starts from the deepest level of array
	constructor.
	* primary.c (match_varspec): If an unknown type is changed to
	default character and the attempt to match a substring fails,
	change it back to unknown.

	PR fortran/34785
	* trans-array.c (gfc_add_loop_ss_code) : If ss->string_length is
	NULL for an array constructor, use the cl.length expression to
	build it.
	(gfc_conv_array_parameter): Change call to gfc_evaluate_now to
	a tree assignment.


2008-01-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34784
	* gfortran.dg/array_constructor_20.f90: New test.
	* gfortran.dg/mapping_2.f90: Correct ubound expression for h4.

	PR fortran/34785
	* gfortran.dg/array_constructor_21.f90: New test.

From-SVN: r131675

7 files changed, 103 insertions, 1 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 11d9c23..41fc1ad 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+2008-01-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34784
+	* array.c (gfc_check_constructor_type): Clear the expression ts
+	so that the checking starts from the deepest level of array
+	constructor.
+	* primary.c (match_varspec): If an unknown type is changed to
+	default character and the attempt to match a substring fails,
+	change it back to unknown.
+
+	PR fortran/34785
+	* trans-array.c (gfc_add_loop_ss_code) : If ss->string_length is
+	NULL for an array constructor, use the cl.length expression to
+	build it.
+	(gfc_conv_array_parameter): Change call to gfc_evaluate_now to
+	a tree assignment.
+
 2008-01-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/34817
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 0c30b33..116937b 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -1025,6 +1025,7 @@ gfc_check_constructor_type (gfc_expr *e)
 
   cons_state = CONS_START;
   gfc_clear_ts (&constructor_ts);
+  gfc_clear_ts (&e->ts);
 
   t = check_constructor_type (e->value.constructor);
   if (t == SUCCESS && e->ts.type == BT_UNKNOWN)
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 4e7d4a1..1895ca0 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1676,6 +1676,7 @@ match_varspec (gfc_expr *primary, int equiv_flag)
   gfc_component *component;
   gfc_symbol *sym = primary->symtree->n.sym;
   match m;
+  bool unknown;
 
   tail = NULL;
 
@@ -1753,12 +1754,14 @@ match_varspec (gfc_expr *primary, int equiv_flag)
     }
 
 check_substring:
+  unknown = false;
   if (primary->ts.type == BT_UNKNOWN)
     {
       if (gfc_get_default_type (sym, sym->ns)->type == BT_CHARACTER)
        {
 	 gfc_set_default_type (sym, 0, sym->ns);
 	 primary->ts = sym->ts;
+	 unknown = true;
        }
     }
 
@@ -1781,6 +1784,8 @@ check_substring:
 	  break;
 
 	case MATCH_NO:
+	  if (unknown)
+	    gfc_clear_ts (&primary->ts);
 	  break;
 
 	case MATCH_ERROR:
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 1718ba9..08c2a80 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1906,6 +1906,18 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript)
 	  break;
 
 	case GFC_SS_CONSTRUCTOR:
+	  if (ss->expr->ts.type == BT_CHARACTER
+		&& ss->string_length== NULL
+		&& ss->expr->ts.cl
+		&& ss->expr->ts.cl->length)
+	    {
+	      gfc_init_se (&se, NULL);
+	      gfc_conv_expr_type (&se, ss->expr->ts.cl->length,
+				  gfc_charlen_type_node);
+	      ss->string_length = se.expr;
+	      gfc_add_block_to_block (&loop->pre, &se.pre);
+	      gfc_add_block_to_block (&loop->post, &se.post);
+	    }
 	  gfc_trans_array_constructor (loop, ss);
 	  break;
 
@@ -5042,7 +5054,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77)
     {
       get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp);
       expr->ts.cl->backend_decl = tmp;
-      se->string_length = gfc_evaluate_now (tmp, &se->pre);
+      se->string_length = tmp;
     }
 
   /* Is this the result of the enclosing procedure?  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 03aa014..c64655f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2008-01-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34784
+	* gfortran.dg/array_constructor_20.f90: New test.
+	* gfortran.dg/mapping_2.f90: Correct ubound expression for h4.
+
+	PR fortran/34785
+	* gfortran.dg/array_constructor_21.f90: New test.
+
 2008-01-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libfortran/34795
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_20.f90 b/gcc/testsuite/gfortran.dg/array_constructor_20.f90
new file mode 100644
index 0000000..de7246d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_20.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+!
+! PR fortran/34784, in which the intrinsic expression would be
+! given the implicit type.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+MODULE m
+  implicit character(s)
+  INTEGER :: I(1) = (/ (SELECTED_INT_KIND(J),J=1,1) /)
+END MODULE m
+
+MODULE s_TESTS
+  IMPLICIT CHARACTER (P)
+CONTAINS
+  subroutine simple (u,j1)
+    optional ::  j1
+    if (present (j1)) stop
+  end subroutine
+END MODULE s_TESTS
+
+! { dg-final { cleanup-modules "m s_TESTS" } }
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_21.f90 b/gcc/testsuite/gfortran.dg/array_constructor_21.f90
new file mode 100644
index 0000000..f9e612c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_21.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! PR fortran/34785, in which the character length of BA_T was not
+! passed on to the array constructor argument of SEQ.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+      MODULE o_TYPE_DEFS
+        implicit none
+        TYPE SEQ
+          SEQUENCE
+          CHARACTER(len = 9) ::  BA(2)
+        END TYPE SEQ
+        CHARACTER(len = 9)   ::  BA_T(2)
+        CHARACTER(LEN = 9)   ::  CA_T(1,2)
+      END MODULE o_TYPE_DEFS
+
+      MODULE TESTS
+        use o_type_defs
+        implicit none
+      CONTAINS
+        SUBROUTINE OG0015(UDS0L)
+          TYPE(SEQ)          UDS0L
+          integer :: j1
+          UDS0L = SEQ((/ (BA_T(J1),J1=1,2) /))
+        END SUBROUTINE
+      END MODULE TESTS
+
+      use o_type_defs
+      CONTAINS
+        SUBROUTINE OG0015(UDS0L)
+          TYPE(SEQ)          UDS0L
+          UDS0L = SEQ(RESHAPE ( (/ ((CA_T(J1,J2), J1 = 1, 1), J2 = 1, 2)/),(/2/)))
+        END SUBROUTINE
+      END
+! { dg-final { cleanup-modules "o_TYPE_DEFS TESTS" } }