2007-02-11 Paul Thomas <pault@gcc.gnu.org>
authorpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 11 Feb 2007 20:58:48 +0000 (20:58 +0000)
committerpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 11 Feb 2007 20:58:48 +0000 (20:58 +0000)
PR fortran/30554
* module.c (find_symtree_for_symbol): New function to return
a symtree that is not a "unique symtree" given a symbol.
(read_module): Do not automatically set pointer_info to
referenced because this inhibits the generation of a unique
symtree.  Recycle the existing symtree if possible by calling
find_symtree_for_symbol.

PR fortran/30319
* decl.c (add_init_expr_to_sym): Make new charlen for an array
constructor initializer.

2007-02-11  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/30554
* gfortran.dg/used_dummy_types_6.f90: Add the "privatized"
versions of the modules.

PR fortran/30617
* gfortran.dg/intrinsic_actual_2.f90: Make this legal fortran
by getting rid of recursive I/O and providing functions with
results.

PR fortran/30319
* gfortran.dg/char_array_constructor_2.f90

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

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/module.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/char_array_constructor_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/intrinsic_actual_2.f90
gcc/testsuite/gfortran.dg/used_dummy_types_6.f90

index a0cf78f..32ae40e 100644 (file)
@@ -1,3 +1,17 @@
+2007-02-11  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/30554
+       * module.c (find_symtree_for_symbol): New function to return
+       a symtree that is not a "unique symtree" given a symbol.
+       (read_module): Do not automatically set pointer_info to
+       referenced because this inhibits the generation of a unique
+       symtree.  Recycle the existing symtree if possible by calling
+       find_symtree_for_symbol.
+
+       PR fortran/30319
+       * decl.c (add_init_expr_to_sym): Make new charlen for an array
+       constructor initializer.
+
 2007-02-10  Richard Henderson  <rth@redhat.com>, Jakub Jelinek  <jakub@redhat.com>
 
        * f95-lang.c (gfc_init_builtin_functions): Add __emutls_get_address
index b25bcc0..f29b035 100644 (file)
@@ -939,8 +939,13 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp,
                gfc_set_constant_character_len (len, init, false);
              else if (init->expr_type == EXPR_ARRAY)
                {
-                 gfc_free_expr (init->ts.cl->length);
+                 /* Build a new charlen to prevent simplification from
+                    deleting the length before it is resolved.  */
+                 init->ts.cl = gfc_get_charlen ();
+                 init->ts.cl->next = gfc_current_ns->cl_list;
+                 gfc_current_ns->cl_list = sym->ts.cl;
                  init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length);
+
                  for (p = init->value.constructor; p; p = p->next)
                    gfc_set_constant_character_len (len, p->expr, false);
                }
index e76bd0e..1dd81e3 100644 (file)
@@ -3304,6 +3304,31 @@ read_cleanup (pointer_info *p)
 }
 
 
+/* Given a root symtree node and a symbol, try to find a symtree that
+   references the symbol that is not a unique name.  */
+
+static gfc_symtree *
+find_symtree_for_symbol (gfc_symtree *st, gfc_symbol *sym)
+{
+  gfc_symtree *s = NULL;
+
+  if (st == NULL)
+    return s;
+
+  s = find_symtree_for_symbol (st->right, sym);
+  if (s != NULL)
+    return s;
+  s = find_symtree_for_symbol (st->left, sym);
+  if (s != NULL)
+    return s;
+
+  if (st->n.sym == sym && !check_unique_name (st->name))
+    return st;
+
+  return s;
+}
+
+
 /* Read a module file.  */
 
 static void
@@ -3363,8 +3388,17 @@ read_module (void)
        continue;
 
       info->u.rsym.state = USED;
-      info->u.rsym.referenced = 1;
       info->u.rsym.sym = sym;
+
+      /* If possible recycle the symtree that references the symbol.
+        If a symtree is not found and the module does not import one,
+        a unique-name symtree is found by read_cleanup.  */
+      st = find_symtree_for_symbol (gfc_current_ns->sym_root, sym);
+      if (st != NULL)
+       {
+         info->u.rsym.symtree = st;
+         info->u.rsym.referenced = 1;
+       }
     }
 
   mio_rparen ();
index 86c4ead..7637326 100644 (file)
@@ -1,3 +1,17 @@
+2007-02-11  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/30554
+       * gfortran.dg/used_dummy_types_6.f90: Add the "privatized"
+       versions of the modules.
+
+       PR fortran/30617
+       * gfortran.dg/intrinsic_actual_2.f90: Make this legal fortran
+       by getting rid of recursive I/O and providing functions with
+       results.
+
+       PR fortran/30319
+       * gfortran.dg/char_array_constructor_2.f90
+
 2007-02-11  Mark Mitchell  <mark@codesourcery.com>
 
        PR c++/26988
diff --git a/gcc/testsuite/gfortran.dg/char_array_constructor_2.f90 b/gcc/testsuite/gfortran.dg/char_array_constructor_2.f90
new file mode 100644 (file)
index 0000000..766eb52
--- /dev/null
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! Tests the fix for PR30319, in which the use of the parameter 'aa' in
+! the array constructor that initialises bb would cause an internal
+! error in resolution.
+!
+! Contributed by Vivek Rao <vivekrao4@yahoo.com>
+!
+module foomod
+  character (len=1), parameter :: aa = "z", bb(1) = (/aa/)
+end module foomod
+  use foomod
+  print *, aa, bb
+end
+! { dg-final { cleanup-modules "foomod" } }
index d24d21f..d7a9c0d 100644 (file)
@@ -4,34 +4,41 @@
 !
 ! Contributed by Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 !
+  integer  :: ans
   TYPE T1 
     INTEGER, POINTER :: I=>NULL() 
-  END TYPE T1 
+  END TYPE T1
+  type(T1), pointer :: tar(:)
   character(20) res
 
   j = 10
-  PRINT *, LEN(SUB(8))
-  PRINT *, LEN(SUB(j))
-! print *, len(SUB(j + 2)//"a")   ! This still fails (no charlen).
-  print *, len(bar(2))
+  PRINT *, LEN(SUB(8)), ans
+  PRINT *, LEN(SUB(j)), ans
+!  print *, len(SUB(j + 2)//"a"), ans   ! This still fails (no charlen).
+  print *, len(bar(2)), ans
 
-  IF(.NOT.ASSOCIATED(F1(10))) CALL ABORT() 
+  IF(.NOT.ASSOCIATED(F1(10))) CALL ABORT()
+  deallocate (tar)
 
 CONTAINS
 
   FUNCTION SUB(I)  
     CHARACTER(LEN=I) :: SUB(1)
-    PRINT *, LEN(SUB(1))
+    ans = LEN(SUB(1))
+    SUB = ""
   END FUNCTION
 
   FUNCTION BAR(I)  
     CHARACTER(LEN=I*10) :: BAR(1)
-    PRINT *, LEN(BAR)
+    ans = LEN(BAR)
+    BAR = ""
   END FUNCTION
 
   FUNCTION F1(I) RESULT(R) 
    TYPE(T1), DIMENSION(:), POINTER :: R 
    INTEGER :: I 
-   ALLOCATE(R(I)) 
-  END FUNCTION F1 
+   ALLOCATE(tar(I))
+   R => tar 
+  END FUNCTION F1
 END 
index bcee65a..ea39051 100644 (file)
@@ -4,6 +4,12 @@
 ! from constraint would not find the existing symtree coming directly
 ! from atom.
 !
+! The last two modules came up subsequently to the original fix.  The
+! PRIVATE statement caused a revival of the original problem.  This
+! was tracked down to an interaction between the symbols being set
+! referenced during module read and the application of the access
+! attribute.
+!
 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
 
 MODULE ATOMS
@@ -22,4 +28,20 @@ MODULE POTENTIAL_ENERGY
 USE ATOMS
 USE CONSTRAINT,         ONLY : ENERGY_CONSTRAINT
 END MODULE POTENTIAL_ENERGY
-! { dg-final { cleanup-modules "atoms constraint potential_energy" } }
+
+MODULE P_CONSTRAINT
+USE ATOMS, ONLY: NFREE
+PRIVATE
+PUBLIC :: ENERGY_CONSTRAINT
+CONTAINS
+   SUBROUTINE ENERGY_CONSTRAINT ( HESSIAN )
+   REAL , DIMENSION(1:(3*NFREE*(3*NFREE+1))/2):: HESSIAN
+   END SUBROUTINE ENERGY_CONSTRAINT
+END MODULE P_CONSTRAINT
+
+MODULE P_POTENTIAL_ENERGY
+USE ATOMS
+USE CONSTRAINT,         ONLY : ENERGY_CONSTRAINT
+END MODULE P_POTENTIAL_ENERGY
+
+! { dg-final { cleanup-modules "atoms constraint potential_energy p_constraint p_potential_energy" } }