]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/42207 ([OOP] Compile-time errors on typed allocation and pointer functi...
authorJanus Weil <janus@gcc.gnu.org>
Wed, 4 Aug 2010 19:49:19 +0000 (21:49 +0200)
committerJanus Weil <janus@gcc.gnu.org>
Wed, 4 Aug 2010 19:49:19 +0000 (21:49 +0200)
2010-08-04  Janus Weil  <janus@gcc.gnu.org>

PR fortran/42207
PR fortran/44064
PR fortran/44065
* class.c (gfc_find_derived_vtab): Do not generate vtabs for class
container types. Do not artificially increase refs. Commit symbols one
by one.
* interface.c (compare_parameter): Make sure vtabs are present before
generating module variables.
* resolve.c (resolve_allocate_expr): Ditto.

2010-08-04  Janus Weil  <janus@gcc.gnu.org>

PR fortran/42207
PR fortran/44064
PR fortran/44065
* gfortran.dg/class_25.f03: New.
* gfortran.dg/class_26.f03: New.

From-SVN: r162879

gcc/fortran/ChangeLog
gcc/fortran/class.c
gcc/fortran/interface.c
gcc/fortran/resolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/class_25.f03 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/class_26.f03 [new file with mode: 0644]

index 7504f491af305067648effd1bee44564929316ac..752b187c6f60af93c072966da9af93b9124c5eff 100644 (file)
@@ -1,3 +1,15 @@
+2010-08-04  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/42207
+       PR fortran/44064
+       PR fortran/44065
+       * class.c (gfc_find_derived_vtab): Do not generate vtabs for class
+       container types. Do not artificially increase refs. Commit symbols one
+       by one.
+       * interface.c (compare_parameter): Make sure vtabs are present before
+       generating module variables.
+       * resolve.c (resolve_allocate_expr): Ditto.
+
 2010-08-04  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/45183
index 558fda2fcf3dea252cfdb879353b7bd09600658c..7dc934452eff73a585332ddf803d54b7a3688a67 100644 (file)
@@ -322,13 +322,16 @@ gfc_find_derived_vtab (gfc_symbol *derived)
   gfc_namespace *ns;
   gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL;
   char name[2 * GFC_MAX_SYMBOL_LEN + 8];
-
-  ns = gfc_current_ns;
-
-  for (; ns; ns = ns->parent)
+  
+  /* Find the top-level namespace (MODULE or PROGRAM).  */
+  for (ns = gfc_current_ns; ns; ns = ns->parent)
     if (!ns->parent)
       break;
 
+  /* If the type is a class container, use the underlying derived type.  */
+  if (derived->attr.is_class)
+    derived = gfc_get_derived_super_type (derived);
+    
   if (ns)
     {
       sprintf (name, "vtab$%s", derived->name);
@@ -338,12 +341,13 @@ gfc_find_derived_vtab (gfc_symbol *derived)
        {
          gfc_get_symbol (name, ns, &vtab);
          vtab->ts.type = BT_DERIVED;
-         vtab->attr.flavor = FL_VARIABLE;
+         if (gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL,
+                             &gfc_current_locus) == FAILURE)
+           goto cleanup;
          vtab->attr.target = 1;
          vtab->attr.save = SAVE_EXPLICIT;
          vtab->attr.vtab = 1;
          vtab->attr.access = ACCESS_PUBLIC;
-         vtab->refs++;
          gfc_set_sym_referenced (vtab);
          sprintf (name, "vtype$%s", derived->name);
          
@@ -358,7 +362,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
                                  NULL, &gfc_current_locus) == FAILURE)
                goto cleanup;
              vtype->attr.access = ACCESS_PUBLIC;
-             vtype->refs++;
              gfc_set_sym_referenced (vtype);
 
              /* Add component '$hash'.  */
@@ -421,7 +424,11 @@ cleanup:
   /* It is unexpected to have some symbols added at resolution or code
      generation time. We commit the changes in order to keep a clean state.  */
   if (found_sym)
-    gfc_commit_symbols ();
+    {
+      gfc_commit_symbol (vtab);
+      if (vtype)
+       gfc_commit_symbol (vtype);
+    }
   else
     gfc_undo_symbols ();
 
index 4ffe5ee33fb21e70c040adae7ccd21a05b441c70..f37f1bdebd7975a594f56ce6ac305787e8a6c569 100644 (file)
@@ -1423,6 +1423,11 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       && actual->ts.u.derived && actual->ts.u.derived->ts.is_iso_c)
     return 1;
 
+  if (formal->ts.type == BT_CLASS)
+    /* Make sure the vtab symbol is present when
+       the module variables are generated.  */
+    gfc_find_derived_vtab (formal->ts.u.derived);
+
   if (actual->ts.type == BT_PROCEDURE)
     {
       char err[200];
index c422eebc27f3ebb1f7d591b16957a47ab4418689..69a003657d92e58a22a5a1abfe9bf39e81760f3b 100644 (file)
@@ -6569,6 +6569,18 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
        }
     }
 
+  if (e->ts.type == BT_CLASS)
+    {
+      /* Make sure the vtab symbol is present when
+        the module variables are generated.  */
+      gfc_typespec ts = e->ts;
+      if (code->expr3)
+       ts = code->expr3->ts;
+      else if (code->ext.alloc.ts.type == BT_DERIVED)
+       ts = code->ext.alloc.ts;
+      gfc_find_derived_vtab (ts.u.derived);
+    }
+
   if (pointer || (dimension == 0 && codimension == 0))
     goto success;
 
index 1f6f826396f66c47517a3144a24bb94eb1cba7b4..8f38f78d3c98c590eadc793b8f0ea456da88f8a5 100644 (file)
@@ -1,3 +1,11 @@
+2010-08-04  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/42207
+       PR fortran/44064
+       PR fortran/44065
+       * gfortran.dg/class_25.f03: New.
+       * gfortran.dg/class_26.f03: New.
+
 2010-08-04  Daniel Gutson  <dgutson@codesourcery.com>
 
        * g++.dg/warn/miss-format-1.C: Update line number.
diff --git a/gcc/testsuite/gfortran.dg/class_25.f03 b/gcc/testsuite/gfortran.dg/class_25.f03
new file mode 100644 (file)
index 0000000..3588b77
--- /dev/null
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! PR [OOP] Compile-time errors on typed allocation and pointer function result assignment
+!
+! Contributed by Damian Rouson <damian@rouson.net>
+
+module m
+
+  implicit none
+
+  type foo 
+  end type
+
+  type ,extends(foo) :: bar
+  end type
+
+contains
+
+  function new_bar()
+    class(foo) ,pointer :: new_bar
+    allocate(bar :: new_bar) 
+  end function
+
+end module
+
+end 
+
+! { dg-final { cleanup-modules "m" } }
diff --git a/gcc/testsuite/gfortran.dg/class_26.f03 b/gcc/testsuite/gfortran.dg/class_26.f03
new file mode 100644 (file)
index 0000000..629c9c9
--- /dev/null
@@ -0,0 +1,29 @@
+! { dg-do run }
+!
+! PR 44065: [OOP] Undefined reference to vtab$...
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module s_mat_mod
+  implicit none 
+  type :: s_sparse_mat
+  end type
+contains
+  subroutine s_set_triangle(a)
+    class(s_sparse_mat), intent(inout) :: a
+  end subroutine
+end module
+
+module s_tester
+implicit none
+contains
+  subroutine s_ussv_2
+    use s_mat_mod
+    type(s_sparse_mat) :: a
+    call s_set_triangle(a)
+  end subroutine
+end module
+
+end
+! { dg-final { cleanup-modules "s_mat_mod s_tester" } }