OSDN Git Service

2007-08-04 Paul Thomas <pault@gcc.gnu.org>
authorpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 4 Aug 2007 20:46:11 +0000 (20:46 +0000)
committerpault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 4 Aug 2007 20:46:11 +0000 (20:46 +0000)
PR fortran/31214
* symbol.c (get_unique_symtree): Moved from module.c.
* module.c (get_unique_symtree): Moved to symbol.c.
* decl.c (get_proc_name): Transfer the typespec from the local
symbol to the module symbol, in the case that an entry is also
a module procedure.  Ensure the local symbol is cleaned up by
pointing to it with a unique symtree.

* dump_parse_tree (gfc_show_code_node): Add EXEC_ASSIGN_CALL.

2007-08-04  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/31214
* gfortran.dg/entry_13.f90: New test.

* gfortran.dg/entry_12.f90: Clean up .mod file.

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

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/dump-parse-tree.c
gcc/fortran/gfortran.h
gcc/fortran/module.c
gcc/fortran/symbol.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/entry_12.f90
gcc/testsuite/gfortran.dg/entry_13.f90 [new file with mode: 0644]

index 2e29300..e9b2ed3 100644 (file)
@@ -1,3 +1,10 @@
+2007-08-04  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/31214
+       * gfortran.dg/entry_13.f90: New test.
+
+       * gfortran.dg/entry_12.f90: Clean up .mod file.
+
 2008-08-04  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/32969
index a94085f..d674aeb 100644 (file)
@@ -681,8 +681,27 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
     {
       /* Present if entry is declared to be a module procedure.  */
       rc = gfc_find_symbol (name, gfc_current_ns->parent, 0, result);
+
       if (*result == NULL)
        rc = gfc_get_symbol (name, NULL, result);
+      else if (gfc_get_symbol (name, NULL, &sym) == 0
+                && sym
+                && sym->ts.type != BT_UNKNOWN
+                && (*result)->ts.type == BT_UNKNOWN
+                && sym->attr.flavor == FL_UNKNOWN)
+       /* Pick up the typespec for the entry, if declared in the function
+          body.  Note that this symbol is FL_UNKNOWN because it will
+          only have appeared in a type declaration.  The local symtree
+          is set to point to the module symbol and a unique symtree
+          to the local version.  This latter ensures a correct clearing
+          of the symbols.  */
+         {
+           (*result)->ts = sym->ts;
+           gfc_find_sym_tree (name, gfc_current_ns, 0, &st);
+           st->n.sym = *result;
+           st = gfc_get_unique_symtree (gfc_current_ns);
+           st->n.sym = sym;
+         }
     }
   else
     rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
index c99fc42..ac6a6f5 100644 (file)
@@ -1084,6 +1084,7 @@ gfc_show_code_node (int level, gfc_code *c)
       break;
 
     case EXEC_CALL:
+    case EXEC_ASSIGN_CALL:
       if (c->resolved_sym)
        gfc_status ("CALL %s ", c->resolved_sym->name);
       else if (c->symtree)
index a87366f..329fae2 100644 (file)
@@ -2124,6 +2124,7 @@ gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
 gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
 gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
 gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
+gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
 gfc_user_op *gfc_get_uop (const char *);
 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
 void gfc_free_symbol (gfc_symbol *);
index fc30eae..baba5c7 100644 (file)
@@ -1822,20 +1822,6 @@ mio_charlen (gfc_charlen **clp)
 }
 
 
-/* Return a symtree node with a name that is guaranteed to be unique
-   within the namespace and corresponds to an illegal fortran name.  */
-
-static gfc_symtree *
-get_unique_symtree (gfc_namespace *ns)
-{
-  char name[GFC_MAX_SYMBOL_LEN + 1];
-  static int serial = 0;
-
-  sprintf (name, "@%d", serial++);
-  return gfc_new_symtree (&ns->sym_root, name);
-}
-
-
 /* See if a name is a generated name.  */
 
 static int
@@ -2287,7 +2273,7 @@ mio_symtree_ref (gfc_symtree **stp)
       if (in_load_equiv && p->u.rsym.symtree == NULL)
        {
          /* Since this is not used, it must have a unique name.  */
-         p->u.rsym.symtree = get_unique_symtree (gfc_current_ns);
+         p->u.rsym.symtree = gfc_get_unique_symtree (gfc_current_ns);
 
          /* Make the symbol.  */
          if (p->u.rsym.sym == NULL)
@@ -3418,7 +3404,7 @@ read_cleanup (pointer_info *p)
     {
       /* Add hidden symbols to the symtree.  */
       q = get_integer (p->u.rsym.ns);
-      st = get_unique_symtree ((gfc_namespace *) q->u.pointer);
+      st = gfc_get_unique_symtree ((gfc_namespace *) q->u.pointer);
 
       st->n.sym = p->u.rsym.sym;
       st->n.sym->refs++;
@@ -3598,7 +3584,7 @@ read_module (void)
              /* Create a symtree node in the current namespace for this
                 symbol.  */
              st = check_unique_name (p)
-                  ? get_unique_symtree (gfc_current_ns)
+                  ? gfc_get_unique_symtree (gfc_current_ns)
                   : gfc_new_symtree (&gfc_current_ns->sym_root, p);
 
              st->ambiguous = ambiguous;
index 40e3435..3aae04c 100644 (file)
@@ -2129,6 +2129,20 @@ gfc_find_symtree (gfc_symtree *st, const char *name)
 }
 
 
+/* Return a symtree node with a name that is guaranteed to be unique
+   within the namespace and corresponds to an illegal fortran name.  */
+
+gfc_symtree *
+gfc_get_unique_symtree (gfc_namespace *ns)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  static int serial = 0;
+
+  sprintf (name, "@%d", serial++);
+  return gfc_new_symtree (&ns->sym_root, name);
+}
+
+
 /* Given a name find a user operator node, creating it if it doesn't
    exist.  These are much simpler than symbols because they can't be
    ambiguous with one another.  */
index d18f3b9..3dabc56 100644 (file)
@@ -1,10 +1,9 @@
-2007-08-04  Thomas Koenig  <tkoenig@gcc.gnu.org>
+2007-08-04  Paul Thomas  <pault@gcc.gnu.org>
 
-       PR fortran/32770
-       * gfortran.dg/streamio_8.f90:  Adjust so test case passes
-       for -fdefault-integer-8 and -fdefault-real-8.
-       * gfortran.dg/streamio_10.f90:  Likewise.
-       * gfortran.dg/sizeof.f90:  Likewise.
+       PR fortran/31214
+       * gfortran.dg/entry_13.f90: New test.
+
+       * gfortran.dg/entry_12.f90: Clean up .mod file.
 
 2007-08-04  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
index 8793b42..5513697 100644 (file)
@@ -1,30 +1,31 @@
-! { dg-do run }\r
-! Tests the fix for pr31609, where module procedure entries found\r
-! themselves in the wrong namespace.  This test checks that all\r
-! combinations of generic and specific calls work correctly.\r
-!\r
-! Contributed by Paul Thomas <pault@gcc.gnu.org> as comment #8 to the pr.\r
-!\r
-MODULE ksbin1_aux_mod\r
-  interface foo\r
-    module procedure j\r
-  end interface\r
-  interface bar\r
-    module procedure k\r
-  end interface\r
-  interface foobar\r
-    module procedure j, k\r
-  end interface\r
-  CONTAINS\r
-    FUNCTION j () \r
-    j = 1\r
-    return\r
-    ENTRY k (i) \r
-    k = 2\r
-    END FUNCTION j\r
-END MODULE ksbin1_aux_mod\r
-\r
-    use ksbin1_aux_mod\r
-    if (any ((/foo (), bar (99), foobar (), foobar (99), j (), k (99)/) .ne. &\r
-             (/1, 2, 1, 2, 1, 2/))) Call abort ()\r
-end\r
+! { dg-do run }
+! Tests the fix for pr31609, where module procedure entries found
+! themselves in the wrong namespace.  This test checks that all
+! combinations of generic and specific calls work correctly.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org> as comment #8 to the pr.
+!
+MODULE ksbin1_aux_mod
+  interface foo
+    module procedure j
+  end interface
+  interface bar
+    module procedure k
+  end interface
+  interface foobar
+    module procedure j, k
+  end interface
+  CONTAINS
+    FUNCTION j () 
+    j = 1
+    return
+    ENTRY k (i) 
+    k = 2
+    END FUNCTION j
+END MODULE ksbin1_aux_mod
+
+    use ksbin1_aux_mod
+    if (any ((/foo (), bar (99), foobar (), foobar (99), j (), k (99)/) .ne. &
+             (/1, 2, 1, 2, 1, 2/))) Call abort ()
+end
+! { dg-final { cleanup-modules "ksbin1_aux_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_13.f90 b/gcc/testsuite/gfortran.dg/entry_13.f90
new file mode 100644 (file)
index 0000000..2d2aeda
--- /dev/null
@@ -0,0 +1,80 @@
+! { dg-do run }
+! Tests the fix for pr31214, in which the typespec for the entry would be lost,
+! thereby causing the function to be disallowed, since the function and entry
+! types did not match.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+module type_mod
+  implicit none
+
+  type x
+     real x
+  end type x
+  type y
+     real x
+  end type y
+  type z
+     real x
+  end type z
+
+  interface assignment(=)
+     module procedure equals
+  end interface assignment(=)
+
+  interface operator(//)
+     module procedure a_op_b, b_op_a
+  end interface operator(//)
+
+  interface operator(==)
+     module procedure a_po_b, b_po_a
+  end interface operator(==)
+
+  contains
+     subroutine equals(x,y)
+        type(z), intent(in) :: y
+        type(z), intent(out) :: x
+
+        x%x = y%x
+     end subroutine equals
+
+     function a_op_b(a,b)
+        type(x), intent(in) :: a
+        type(y), intent(in) :: b
+        type(z) a_op_b
+        type(z) b_op_a
+        a_op_b%x = a%x + b%x
+        return
+     entry b_op_a(b,a)
+        b_op_a%x = a%x - b%x
+     end function a_op_b
+
+     function a_po_b(a,b)
+        type(x), intent(in) :: a
+        type(y), intent(in) :: b
+        type(z) a_po_b
+        type(z) b_po_a
+     entry b_po_a(b,a)
+        a_po_b%x = a%x/b%x
+     end function a_po_b
+end module type_mod
+
+program test
+  use type_mod
+  implicit none
+  type(x) :: x1 = x(19.0_4)
+  type(y) :: y1 = y(7.0_4)
+  type(z) z1
+
+  z1 = x1//y1
+  if (z1%x .ne. 19.0_4 + 7.0_4) call abort ()
+  z1 = y1//x1
+  if (z1%x .ne. 19.0_4 - 7.0_4) call abort ()
+
+  z1 = x1==y1
+  if (z1%x .ne. 19.0_4/7.0_4) call abort ()
+  z1 = y1==x1
+  if (z1%x .ne. 19.0_4/7.0_4) call abort ()
+end program test
+! { dg-final { cleanup-modules "type_mod" } }
+