OSDN Git Service

2007-09-05 Paul Thomas <pault@gcc.gnu.org>
authorpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 5 Sep 2007 13:34:25 +0000 (13:34 +0000)
committerpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 5 Sep 2007 13:34:25 +0000 (13:34 +0000)
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.

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

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/primary.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/char_length_10.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90 [new file with mode: 0644]

index 6ac59b6..e1d6ecf 100644 (file)
@@ -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>
 
index 470cbfa..f9f92ad 100644 (file)
@@ -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)
index 2be27d7..f622996 100644 (file)
@@ -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:
index aa4306b..c6ba699 100644 (file)
@@ -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 (file)
index 0000000..23bb37f
--- /dev/null
@@ -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\r
+  IMPLICIT NONE\r
+  CHARACTER (LEN=*), DIMENSION(1),  PARAMETER :: var  = 'a'\r
+  CALL parsef (var)\r
+contains\r
+  SUBROUTINE parsef (Var)\r
+    IMPLICIT NONE\r
+    CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var\r
+  END SUBROUTINE parsef\r
+END PROGRAM fptest\r
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 (file)
index 0000000..0530b0e
--- /dev/null
@@ -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\r
+  TYPE :: the_distribution\r
+    INTEGER :: parameters(2)\r
+  END TYPE the_distribution\r
+  TYPE (the_distribution), PARAMETER :: the_beta = the_distribution((/99,999/))
+CONTAINS\r
+  SUBROUTINE set_bound(arg_name, test)\r
+    INTEGER, INTENT (IN) :: arg_name, test
+    if (arg_name .ne. test) call abort ()\r
+  END SUBROUTINE set_bound\r
+END MODULE cdf_aux_mod
+\r
+MODULE cdf_beta_mod\r
+CONTAINS\r
+  SUBROUTINE cdf_beta(which, test)\r
+    USE cdf_aux_mod\r
+    INTEGER :: which, test\r
+    CALL set_bound(the_beta%parameters(which), test)\r
+  END SUBROUTINE cdf_beta\r
+END MODULE cdf_beta_mod
+\r
+  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" } }