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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131675 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 11d9c23..41fc1ad 100644 (file)
--- 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
 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 (file)
--- 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);
 
   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)
 
   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 (file)
--- 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;
   gfc_component *component;
   gfc_symbol *sym = primary->symtree->n.sym;
   match m;

+  bool unknown;

 
   tail = NULL;
 
 
   tail = NULL;
 


@@ -1753,12 +1754,14 @@ match_varspec (gfc_expr *primary, int equiv_flag)
     }
 
 check_substring:
     }
 
 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;
   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:
          break;
 
        case MATCH_NO:

+         if (unknown)
+           gfc_clear_ts (&primary->ts);

          break;
 
        case MATCH_ERROR:
          break;
 
        case MATCH_ERROR:

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 1718ba9..08c2a80 100644 (file)
--- 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:
          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;
 
          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;
     {
       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?  */
     }
 
   /* Is this the result of the enclosing procedure?  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 03aa014..c64655f 100644 (file)
--- 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
 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 (file)
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 (file)
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" } }