Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-13 Thread Alessandro Fanfarillo
Dear all,

in attachment the new draft which also supports the polymorphic
deallocation via INTENT(OUT). Tomorrow I'll try to realize a draft for
the deallocation at the end of the scope.

Regards

2012/6/12 Alessandro Fanfarillo fanfarillo@gmail.com:
 I don't know if there's already a PR but I get an ICE compiling this
 with a non-patched version. If x is not an array everything goes ok.

 2012/6/11 Tobias Burnus bur...@net-b.de:
 On 06/11/2012 11:24 AM, Alessandro Fanfarillo wrote:

 gfortran.dg/coarray/poly_run_3.f90


 That one fails because I for forgot that se.expr in gfc_trans_deallocate
 contains the descriptor and not the pointer to the data. That's fixed by:

          tmp = se.expr;
          if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
            {
              tmp = gfc_conv_descriptor_data_get (tmp);
              STRIP_NOPS (tmp);

            }
          tmp =  fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
                                  tmp, build_int_cst (TREE_TYPE (tmp), 0));

 However, it still fails for the

 type t
  integer, allocatable :: comp
 end type t
 contains
  subroutine foo(x)
    class(t), allocatable, intent(out) :: x(:)
  end subroutine
 end

 (The intent(out) causes automatic deallocation.) The backtrace does not
 really point to some code which the patch touched; it shouldn't be affected
 by the class.c changes and gfc_trans_deallocate does not seem to be entered.

 While I do not immediately see why it fails, I wonder whether it is due to
 the removed else if ... BT_CLASS) case in
 gfc_deallocate_scalar_with_status. In any case, the change to
 gfc_trans_deallocate might be also needed for
 gfc_deallocate_scalar_with_status. At least, automatic deallocation (with
 intent(out) or when leaving the scope) does not seem to go through
 gfc_trans_deallocate but only through gfc_deallocate_scalar_with_status.

 Tobias
Index: gcc/fortran/trans-decl.c
===
--- gcc/fortran/trans-decl.c(revisione 188511)
+++ gcc/fortran/trans-decl.c(copia locale)
@@ -3423,6 +3423,63 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wra
   gfc_init_block (init);
   for (f = proc_sym-formal; f; f = f-next)
 if (f-sym  f-sym-attr.intent == INTENT_OUT
+f-sym-ts.type == BT_CLASS
+!CLASS_DATA (f-sym)-attr.class_pointer
+CLASS_DATA (f-sym)-ts.u.derived-attr.alloc_comp)
+  {
+   gfc_expr *expr, *ppc;
+   gfc_se se, free_se;
+   gfc_code *ppc_code;
+   gfc_actual_arglist *actual;
+   tree cond;
+   f-sym-attr.referenced = 1;
+   expr = gfc_lval_expr_from_sym(f-sym);
+   gcc_assert (expr-expr_type == EXPR_VARIABLE);
+
+   if (expr-ts.type == BT_CLASS)
+ gfc_add_data_component (expr);
+
+   gfc_init_se (se, NULL);
+   gfc_start_block (se.pre);
+   se.want_pointer = 1;
+   se.descriptor_only = 1;
+   gfc_conv_expr (se, expr);
+   ppc = gfc_lval_expr_from_sym(f-sym);;
+   gfc_add_vptr_component (ppc);
+   gfc_add_component_ref (ppc, _free);
+   gfc_init_se (free_se, NULL);
+   free_se.want_pointer = 1;
+   gfc_conv_expr (free_se, ppc);
+   tmp = se.expr;
+   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ {
+   tmp = gfc_conv_descriptor_data_get (tmp);
+   STRIP_NOPS (tmp);
+ }
+   cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+   free_se.expr,
+   build_int_cst (TREE_TYPE (free_se.expr), 0));
+   tmp =  fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+   tmp, build_int_cst (TREE_TYPE (tmp), 0));
+   cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+   boolean_type_node, cond, tmp);
+
+   actual = gfc_get_actual_arglist ();
+   actual-expr = gfc_copy_expr (expr);
+
+   ppc_code = gfc_get_code ();
+   ppc_code-resolved_sym = ppc-symtree-n.sym;
+   ppc_code-resolved_sym-attr.elemental = 1;
+   ppc_code-ext.actual = actual;
+   ppc_code-expr1 = ppc;
+   ppc_code-op = EXEC_CALL;
+   tmp = gfc_trans_call (ppc_code, true, NULL, NULL, false);
+   tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+   cond, tmp, build_empty_stmt (input_location));
+gfc_add_expr_to_block (init, tmp);
+gfc_free_statements (ppc_code);
+  }
+else if (f-sym  f-sym-attr.intent == INTENT_OUT
 !f-sym-attr.pointer
 f-sym-ts.type == BT_DERIVED)
   {
@@ -3446,7 +3503,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wra
else if (f-sym-value)
  gfc_init_default_dt (f-sym, init, true);
   }
-else if (f-sym  f-sym-attr.intent == INTENT_OUT
+/*else if (f-sym  f-sym-attr.intent == INTENT_OUT
  f-sym-ts.type == BT_CLASS
  !CLASS_DATA (f-sym)-attr.class_pointer
  

Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-12 Thread Alessandro Fanfarillo
I don't know if there's already a PR but I get an ICE compiling this
with a non-patched version. If x is not an array everything goes ok.

2012/6/11 Tobias Burnus bur...@net-b.de:
 On 06/11/2012 11:24 AM, Alessandro Fanfarillo wrote:

 gfortran.dg/coarray/poly_run_3.f90


 That one fails because I for forgot that se.expr in gfc_trans_deallocate
 contains the descriptor and not the pointer to the data. That's fixed by:

          tmp = se.expr;
          if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
            {
              tmp = gfc_conv_descriptor_data_get (tmp);
              STRIP_NOPS (tmp);

            }
          tmp =  fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
                                  tmp, build_int_cst (TREE_TYPE (tmp), 0));

 However, it still fails for the

 type t
  integer, allocatable :: comp
 end type t
 contains
  subroutine foo(x)
    class(t), allocatable, intent(out) :: x(:)
  end subroutine
 end

 (The intent(out) causes automatic deallocation.) The backtrace does not
 really point to some code which the patch touched; it shouldn't be affected
 by the class.c changes and gfc_trans_deallocate does not seem to be entered.

 While I do not immediately see why it fails, I wonder whether it is due to
 the removed else if ... BT_CLASS) case in
 gfc_deallocate_scalar_with_status. In any case, the change to
 gfc_trans_deallocate might be also needed for
 gfc_deallocate_scalar_with_status. At least, automatic deallocation (with
 intent(out) or when leaving the scope) does not seem to go through
 gfc_trans_deallocate but only through gfc_deallocate_scalar_with_status.

 Tobias


Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-11 Thread Alessandro Fanfarillo
Thank you for the review, with this patch I get some ICEs during the
regstest with:

gfortran.dg/coarray/poly_run_3.f90
gfortran.dg/elemental_optional_args_5.f03
gfortran.dg/select_type_26.f03
gfortran.dg/select_type_27.f03
gfortran.dg/class_48.f90
gfortran.dg/class_allocate_10.f03
gfortran.dg/class_allocate_8.f03
gfortran.dg/class_array_1.f03
gfortran.dg/class_array_2.f03
gfortran.dg/assumed_type_2.f90
gfortran.dg/class_array_9.f03
gfortran.dg/coarray_lib_alloc_2.f90

I've debugged only the first 2 and the problem seems to be related
with tmp =  fold_build2_loc (input_location, NE_EXPR,
boolean_type_node, se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); 
in trans-stmt.c at line 5376. The ICE message is the following:

$ gcc/bin/gfortran -c elemental_optional_args_5.f03
elemental_optional_args_5.f03: In function ‘MAIN__’:
elemental_optional_args_5.f03:220:0: internal compiler error: in
build_int_cst_wide, at tree.c:1219
 deallocate (taa, tpa, caa, cpa)
 ^
Please submit a full bug report,
with preprocessed source if appropriate.
See http://gcc.gnu.org/bugs.html for instructions.



2012/6/10 Tobias Burnus bur...@net-b.de:
 Alessandro Fanfarillo wrote:

 with the priceless support of Tobias I've almost realized the patch
 for this PR. In attachment there's the second draft. During the
 regression test I have only one error with select_type_4.f90. The
 problem is in the destroy_list subroutine when it checks
 associated(node) after the first deallocate(node).


 --- gcc/fortran/trans-stmt.c    (revisione 188002)
 +++ gcc/fortran/trans-stmt.c    (copia locale)
 @@ -5341,7 +5341,12 @@ gfc_trans_deallocate (gfc_code *code)
    for (al = code-ext.alloc.list; al != NULL; al = al-next)
     {
 -      gfc_expr *expr = gfc_copy_expr (al-expr);
 +      gfc_expr *expr;
 +      gfc_expr *ppc;
 +      gfc_code *ppc_code;
 +      gfc_actual_arglist *actual;
 +      expr = gfc_copy_expr (al-expr);
 +      ppc = gfc_copy_expr (expr);
 ...
 +      if (expr-symtree-n.sym-ts.type == BT_CLASS)


 I'd prefer:

 gfc_expr *ppc = NULL;
 ...
 if (expr-ts.type == BT_CLASS)
  ppc = gfc_copy_expr (expr);
 ...
 if (ppc)
  ...

 Namely: Only copy the expression if needed.

 Additionally, the check if (expr-symtree-n.sym-ts.type == BT_CLASS) is
 wrong. For instance, for
  type(t) :: x
  deallocate(x%class)
 it won't trigger, but it should.

 Actually, I think a cleaner version would be:

 if (al-expr-ts.type == BT_CLASS)
  {
    gfc_expr *ppc;
    ppc = gfc_copy_expr (al-expr);

  * * *

 Furthermore, I think you call _free + free for the same component for:

 type t
   integer, allocatable :: x
 end type t
 class(t), allocatable :: y
 ...
 deallocate (y)

 * * *

 Regarding your code: You assume that al-expr points to an allocated
 variable, that's not the always the case - hence, select_type_4.f90 fails.

 * * *

 You always create a _free function; I wonder whether it makes sense to use
 _vtab-free with NULL in case that no _free is needed.

  * * *

 Attached an updated version, which does that all. No guarantee that it works
 correctly, but it should at least fix select_type_4.f90.

 Tobias


Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-11 Thread Tobias Burnus

On 06/11/2012 11:24 AM, Alessandro Fanfarillo wrote:

gfortran.dg/coarray/poly_run_3.f90


That one fails because I for forgot that se.expr in gfc_trans_deallocate 
contains the descriptor and not the pointer to the data. That's fixed by:


  tmp = se.expr;
  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
{
  tmp = gfc_conv_descriptor_data_get (tmp);
  STRIP_NOPS (tmp);
}
  tmp =  fold_build2_loc (input_location, NE_EXPR, 
boolean_type_node,

  tmp, build_int_cst (TREE_TYPE (tmp), 0));

However, it still fails for the

type t
  integer, allocatable :: comp
end type t
contains
  subroutine foo(x)
class(t), allocatable, intent(out) :: x(:)
  end subroutine
end

(The intent(out) causes automatic deallocation.) The backtrace does not 
really point to some code which the patch touched; it shouldn't be 
affected by the class.c changes and gfc_trans_deallocate does not seem 
to be entered.


While I do not immediately see why it fails, I wonder whether it is due 
to the removed else if ... BT_CLASS) case in 
gfc_deallocate_scalar_with_status. In any case, the change to 
gfc_trans_deallocate might be also needed for 
gfc_deallocate_scalar_with_status. At least, automatic deallocation 
(with intent(out) or when leaving the scope) does not seem to go through 
gfc_trans_deallocate but only through gfc_deallocate_scalar_with_status.


Tobias


Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-10 Thread Tobias Burnus

Alessandro Fanfarillo wrote:

with the priceless support of Tobias I've almost realized the patch
for this PR. In attachment there's the second draft. During the
regression test I have only one error with select_type_4.f90. The
problem is in the destroy_list subroutine when it checks
associated(node) after the first deallocate(node).


--- gcc/fortran/trans-stmt.c(revisione 188002)
+++ gcc/fortran/trans-stmt.c(copia locale)
@@ -5341,7 +5341,12 @@ gfc_trans_deallocate (gfc_code *code)
 
   for (al = code-ext.alloc.list; al != NULL; al = al-next)

 {
-  gfc_expr *expr = gfc_copy_expr (al-expr);
+  gfc_expr *expr;
+  gfc_expr *ppc;
+  gfc_code *ppc_code;
+  gfc_actual_arglist *actual;
+  expr = gfc_copy_expr (al-expr);
+  ppc = gfc_copy_expr (expr);
...
+  if (expr-symtree-n.sym-ts.type == BT_CLASS)


I'd prefer:

gfc_expr *ppc = NULL;
...
if (expr-ts.type == BT_CLASS)
  ppc = gfc_copy_expr (expr);
...
if (ppc)
  ...

Namely: Only copy the expression if needed.

Additionally, the check if (expr-symtree-n.sym-ts.type == BT_CLASS) 
is wrong. For instance, for

  type(t) :: x
  deallocate(x%class)
it won't trigger, but it should.

Actually, I think a cleaner version would be:

if (al-expr-ts.type == BT_CLASS)
  {
gfc_expr *ppc;
ppc = gfc_copy_expr (al-expr);

 * * *

Furthermore, I think you call _free + free for the same component for:

type t
   integer, allocatable :: x
end type t
class(t), allocatable :: y
...
deallocate (y)

* * *

Regarding your code: You assume that al-expr points to an allocated 
variable, that's not the always the case - hence, select_type_4.f90 fails.


* * *

You always create a _free function; I wonder whether it makes sense to 
use _vtab-free with NULL in case that no _free is needed.


 * * *

Attached an updated version, which does that all. No guarantee that it 
works correctly, but it should at least fix select_type_4.f90.


Tobias
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index c71aa4a..8224f45 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -42,6 +42,7 @@ along with GCC; see the file COPYING3.  If not see
 * _extends:  A pointer to the vtable entry of the parent derived type.
 * _def_init: A pointer to a default initialized variable of this type.
 * _copy: A procedure pointer to a copying procedure.
+* _free: A procedure pointer to a free procedure.
After these follow procedure pointer components for the specific
type-bound procedures.  */
 
@@ -717,6 +718,9 @@ gfc_find_derived_vtab (gfc_symbol *derived)
   gfc_namespace *ns;
   gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL, *def_init = NULL;
   gfc_symbol *copy = NULL, *src = NULL, *dst = NULL;
+  gfc_symbol *free = NULL, *tofree = NULL;
+  gfc_component *temp = NULL;
+  bool comp_alloc;
 
   /* Find the top-level namespace (MODULE or PROGRAM).  */
   for (ns = gfc_current_ns; ns; ns = ns-parent)
@@ -907,6 +911,101 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 		  c-ts.interface = copy;
 		}
 
+	  /* Add component _free.  */
+	  comp_alloc = false;
+
+	  for (temp = derived-components; temp; temp = temp-next)
+		{
+		  if (temp == derived-components  derived-attr.extension)
+		continue;
+
+		  if (temp-ts.type != BT_CLASS
+		   !temp-attr.pointer
+		   (temp-attr.alloc_comp || temp-attr.allocatable))
+		comp_alloc = true;
+		  else if (temp-ts.type == BT_CLASS
+			CLASS_DATA (temp)
+			CLASS_DATA (temp)-attr.allocatable)
+		comp_alloc = true;
+		}
+
+	  if (gfc_add_component (vtype, _free, c) == FAILURE)
+		goto cleanup;
+	  c-attr.proc_pointer = 1;
+	  c-attr.access = ACCESS_PRIVATE;
+	  c-tb = XCNEW (gfc_typebound_proc);
+	  c-tb-ppc = 1;
+
+	  if (!derived-attr.alloc_comp || derived-attr.abstract)
+		c-initializer = gfc_get_null_expr (NULL);
+	  else if (derived-attr.extension  !comp_alloc
+		!derived-components-attr.abstract)
+		{
+		  /* No new allocatable components: Link to the parent's _free.  */
+		  gfc_component *parent = derived-components;
+		  gfc_component *free_proc = NULL;
+		  gfc_symbol *vtab2 = NULL;
+		  vtab2 = gfc_find_derived_vtab (parent-ts.u.derived);
+
+		  for (free_proc = vtab2-ts.u.derived-components;
+		   free_proc; free_proc = free_proc-next)
+		if (free_proc-name[0] == '_'
+			 free_proc-name[1] == 'f')
+		  break;
+		  gcc_assert (free_proc);
+
+		  c-initializer = gfc_copy_expr (free_proc-initializer);
+		  c-ts.interface = free_proc-ts.interface;
+		}
+	  else
+		{
+		  gfc_alloc *head = NULL;
+
+		  /* Create _free function. Set up its namespace.  */
+		  gfc_namespace *sub_ns2 = gfc_get_namespace (ns, 0);
+		  sub_ns2-sibling = ns-contained;
+		  ns-contained = sub_ns2;
+		  sub_ns2-resolved = 1;
+
+		  /* Set up procedure symbol.  */
+		  sprintf (name, __free_%s, tname);
+		  gfc_get_symbol (name, sub_ns2, free);
+		  sub_ns2-proc_name = free;
+		  free-attr.flavor = 

Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-09 Thread Alessandro Fanfarillo
Hi all,
with the priceless support of Tobias I've almost realized the patch
for this PR. In attachment there's the second draft. During the
regression test I have only one error with select_type_4.f90. The
problem is in the destroy_list subroutine when it checks
associated(node) after the first deallocate(node).

2012/6/5 Paul Richard Thomas paul.richard.tho...@gmail.com:
 Hi Alessandro,

 I am glad to see that Janus is giving you a helping hand, in addition
 to Tobias.  I am so tied up with every aspect of life that gfortran is
 not figuring much at all.

 When you clean up the patch, you might consider making this into a
 separate function:

 +         if (free_proc)
 +           {
 +             ppc = gfc_copy_expr(free_proc-initializer);
 +             ppc_code = gfc_get_code ();
 +             ppc_code-resolved_sym = ppc-symtree-n.sym;
 +             ppc_code-resolved_sym-attr.elemental = 1;
 +             ppc_code-ext.actual = actual;
 +             ppc_code-expr1 = ppc;
 +             ppc_code-op = EXEC_CALL;
 +             tmp = gfc_trans_call (ppc_code, true, NULL, NULL, false);
 +             gfc_free_statements (ppc_code);
 +             gfc_add_expr_to_block (block, tmp);
 +           }

 ... and using the function call to replace the corresponding call to
 _copy in trans_allocate.

 I suspect that we are going to do this some more :-)

 Once we have the separate function, we could at later stage replace it
 by a TREE_SSA version.

 Cheers

 Paul

 On 3 June 2012 12:15, Alessandro Fanfarillo fanfarillo@gmail.com wrote:
 Right, the problem is that the _free component is missing. Just as the
 _copy component, _free should be present for *every* vtype, no matter
 if there are allocatable components or not. If the _free component is
 not needed, it should be initialized to EXPR_NULL.

 With an empty _free function for every type which does not have
 allocatable components the problem with dynamic_dispatch_4.f03
 disappears :), thank you very much. In the afternoon I'll reorganize
 the code.

 Bye.

 Alessandro



 --
 The knack of flying is learning how to throw yourself at the ground and miss.
        --Hitchhikers Guide to the Galaxy
Index: gcc/testsuite/gfortran.dg/class_19.f03
===
--- gcc/testsuite/gfortran.dg/class_19.f03  (revisione 188002)
+++ gcc/testsuite/gfortran.dg/class_19.f03  (copia locale)
@@ -39,5 +39,5 @@ program main
 
 end program main
 
-! { dg-final { scan-tree-dump-times __builtin_free 11 original } }
+! { dg-final { scan-tree-dump-times __builtin_free 14 original } }
 ! { dg-final { cleanup-tree-dump original } }
Index: gcc/testsuite/gfortran.dg/auto_dealloc_2.f90
===
--- gcc/testsuite/gfortran.dg/auto_dealloc_2.f90(revisione 188002)
+++ gcc/testsuite/gfortran.dg/auto_dealloc_2.f90(copia locale)
@@ -25,5 +25,5 @@ contains
 
 end program 
 
-! { dg-final { scan-tree-dump-times __builtin_free 3 original } }
+! { dg-final { scan-tree-dump-times __builtin_free 4 original } }
 ! { dg-final { cleanup-tree-dump original } }
Index: gcc/fortran/trans-stmt.c
===
--- gcc/fortran/trans-stmt.c(revisione 188002)
+++ gcc/fortran/trans-stmt.c(copia locale)
@@ -5341,7 +5341,12 @@ gfc_trans_deallocate (gfc_code *code)
 
   for (al = code-ext.alloc.list; al != NULL; al = al-next)
 {
-  gfc_expr *expr = gfc_copy_expr (al-expr);
+  gfc_expr *expr;
+  gfc_expr *ppc;
+  gfc_code *ppc_code;
+  gfc_actual_arglist *actual;
+  expr = gfc_copy_expr (al-expr);
+  ppc = gfc_copy_expr (expr);
   gcc_assert (expr-expr_type == EXPR_VARIABLE);
 
   if (expr-ts.type == BT_CLASS)
@@ -5354,6 +5359,24 @@ gfc_trans_deallocate (gfc_code *code)
   se.descriptor_only = 1;
   gfc_conv_expr (se, expr);
 
+  actual = gfc_get_actual_arglist ();
+  actual-expr = gfc_copy_expr (expr);
+
+  if (expr-symtree-n.sym-ts.type == BT_CLASS)
+   {
+ gfc_add_vptr_component (ppc);
+ gfc_add_component_ref (ppc, _free);
+ ppc_code = gfc_get_code ();
+ ppc_code-resolved_sym = ppc-symtree-n.sym;
+ ppc_code-resolved_sym-attr.elemental = 1;
+ ppc_code-ext.actual = actual;
+ ppc_code-expr1 = ppc;
+ ppc_code-op = EXEC_CALL;
+ tmp = gfc_trans_call (ppc_code, true, NULL, NULL, false);
+ gfc_free_statements (ppc_code);
+ gfc_add_expr_to_block (block, tmp);
+   }
+
   if (expr-rank || gfc_is_coarray (expr))
{
  if (expr-ts.type == BT_DERIVED  
expr-ts.u.derived-attr.alloc_comp)
Index: gcc/fortran/class.c
===
--- gcc/fortran/class.c (revisione 188002)
+++ gcc/fortran/class.c (copia locale)
@@ -717,6 +717,9 @@ gfc_find_derived_vtab (gfc_symbol *derived)
   gfc_namespace *ns;
   

Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-05 Thread Paul Richard Thomas
Hi Alessandro,

I am glad to see that Janus is giving you a helping hand, in addition
to Tobias.  I am so tied up with every aspect of life that gfortran is
not figuring much at all.

When you clean up the patch, you might consider making this into a
separate function:

+ if (free_proc)
+   {
+ ppc = gfc_copy_expr(free_proc-initializer);
+ ppc_code = gfc_get_code ();
+ ppc_code-resolved_sym = ppc-symtree-n.sym;
+ ppc_code-resolved_sym-attr.elemental = 1;
+ ppc_code-ext.actual = actual;
+ ppc_code-expr1 = ppc;
+ ppc_code-op = EXEC_CALL;
+ tmp = gfc_trans_call (ppc_code, true, NULL, NULL, false);
+ gfc_free_statements (ppc_code);
+ gfc_add_expr_to_block (block, tmp);
+   }

... and using the function call to replace the corresponding call to
_copy in trans_allocate.

I suspect that we are going to do this some more :-)

Once we have the separate function, we could at later stage replace it
by a TREE_SSA version.

Cheers

Paul

On 3 June 2012 12:15, Alessandro Fanfarillo fanfarillo@gmail.com wrote:
 Right, the problem is that the _free component is missing. Just as the
 _copy component, _free should be present for *every* vtype, no matter
 if there are allocatable components or not. If the _free component is
 not needed, it should be initialized to EXPR_NULL.

 With an empty _free function for every type which does not have
 allocatable components the problem with dynamic_dispatch_4.f03
 disappears :), thank you very much. In the afternoon I'll reorganize
 the code.

 Bye.

 Alessandro



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy


Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-03 Thread Alessandro Fanfarillo
 Right, the problem is that the _free component is missing. Just as the
 _copy component, _free should be present for *every* vtype, no matter
 if there are allocatable components or not. If the _free component is
 not needed, it should be initialized to EXPR_NULL.

With an empty _free function for every type which does not have
allocatable components the problem with dynamic_dispatch_4.f03
disappears :), thank you very much. In the afternoon I'll reorganize
the code.

Bye.

Alessandro


[Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-02 Thread Alessandro Fanfarillo
Dear all,

I have realized a draft patch for the PR 46321, currently it works
only with the explicit DEALLOCATE.

Running the regression tests it doesn't pass the following:

- gfortran.dg/class_19.f03 (too much __builtin_free)
- gfortran.dg/auto_dealloc_2.f90 (too much __builtin_free)
- gfortran.dg/dynamic_dispatch_4.f03 (free on invalid pointer)
- gfortran.dg/typebound_operator_9.f03 (fails during the execution test)

The first two tests fail due to the introduction of __builtin_free
in the freeing functions, so it is not a problem.

The gfortran.dg/dynamic_dispatch_4.f03 had this problem in the past
(http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43986); currently it
calls the __free_s_bar_mod_S_bar function instead of the proper
doit().

Regarding typebound_operator_9.f03, I don't know how to fix the patch...

The patch is written in a raw way due to my newbieness, so any
suggestion is well accepted.

Regards.

Alessandro
Index: gcc/fortran/class.c
===
--- gcc/fortran/class.c (revisione 188002)
+++ gcc/fortran/class.c (copia locale)
@@ -717,6 +717,7 @@
   gfc_namespace *ns;
   gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL, *def_init = NULL;
   gfc_symbol *copy = NULL, *src = NULL, *dst = NULL;
+  gfc_symbol *free = NULL, *tofree = NULL;
 
   /* Find the top-level namespace (MODULE or PROGRAM).  */
   for (ns = gfc_current_ns; ns; ns = ns-parent)
@@ -907,6 +908,119 @@
  c-ts.interface = copy;
}
 
+ /* Add component _free.  */
+ gfc_component *temp = NULL;
+ bool der_comp_alloc = false, comp_alloc = false;
+ bool  class_comp_alloc = false;
+ for (temp = derived-components; temp; temp = temp-next)
+   {
+ if (temp == derived-components  derived-attr.extension)
+   continue;
+
+ if (temp-ts.type == BT_DERIVED
+  !temp-attr.pointer
+  (temp-attr.alloc_comp || temp-attr.allocatable))
+   der_comp_alloc = true;
+ else if (temp-ts.type != BT_DERIVED
+   !temp-attr.pointer
+   (temp-attr.alloc_comp
+  || temp-attr.allocatable))
+   comp_alloc = true;
+ else if (temp-ts.u.derived
+   temp-ts.type == BT_CLASS
+   CLASS_DATA (temp)
+  // (CLASS_DATA (temp)-attr.class_pointer
+  //|| CLASS_DATA (temp)-attr.allocatable))
+   CLASS_DATA (temp)-attr.allocatable)
+   class_comp_alloc = true;
+   }
+ if (derived-attr.extension
+  (!der_comp_alloc  !comp_alloc  !class_comp_alloc))
+   {
+ gfc_component *parent = derived-components;
+ gfc_component *free_proc = NULL;
+ gfc_symbol *vtab2 = NULL;
+ gfc_expr *tmp1 = NULL, *tmp2 = NULL;
+ vtab2 = gfc_find_derived_vtab (parent-ts.u.derived);
+
+ for (free_proc = vtab2-ts.u.derived-components;
+  free_proc; free_proc = free_proc-next)
+   if (free_proc-name[0] == '_'
+free_proc-name[1] == 'f')
+ break;
+
+ if (!free_proc)
+   goto end_vtab;
+
+ if (gfc_add_component (vtype, _free, c) == FAILURE)
+   goto cleanup;
+ c-attr.proc_pointer = 1;
+ c-attr.access = ACCESS_PRIVATE;
+ c-tb = XCNEW (gfc_typebound_proc);
+ c-tb-ppc = 1;
+ /* Not sure about this part */
+ tmp1 = gfc_lval_expr_from_sym (free_proc-ts.interface);
+ tmp2 = gfc_copy_expr (tmp1);
+ c-initializer = tmp2;
+ c-ts.interface = tmp2-symtree-n.sym;
+ goto end_vtab;
+
+   }
+
+ if (derived-attr.alloc_comp || der_comp_alloc
+ || class_comp_alloc)
+   {
+ gfc_alloc *head = NULL;
+ if (gfc_add_component (vtype, _free, c) == FAILURE)
+   goto cleanup;
+ c-attr.proc_pointer = 1;
+ c-attr.access = ACCESS_PRIVATE;
+ c-tb = XCNEW (gfc_typebound_proc);
+ c-tb-ppc = 1;
+ if (derived-attr.abstract)
+   c-initializer = gfc_get_null_expr (NULL);
+ else
+   {
+ /* Set up namespace.  */
+ gfc_namespace *sub_ns2 = gfc_get_namespace (ns, 0);
+ sub_ns2-sibling = ns-contained;
+ ns-contained = sub_ns2;
+ sub_ns2-resolved = 1;
+ 

Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-02 Thread Janus Weil
Hi Alessandro,

 I have realized a draft patch for the PR 46321, currently it works
 only with the explicit DEALLOCATE.

thanks for the patch! Some first comments without actually looking at
the patch in detail ...


 Running the regression tests it doesn't pass the following:

 - gfortran.dg/class_19.f03 (too much __builtin_free)
 - gfortran.dg/auto_dealloc_2.f90 (too much __builtin_free)
 - gfortran.dg/dynamic_dispatch_4.f03 (free on invalid pointer)
 - gfortran.dg/typebound_operator_9.f03 (fails during the execution test)

 The first two tests fail due to the introduction of __builtin_free
 in the freeing functions, so it is not a problem.

Right. You should certainly fix the scan-tree-dump-times checks (by
adjusting the numbers properly, and making sure that they are actually
what one would expect), in order to make them pass.


 The gfortran.dg/dynamic_dispatch_4.f03 had this problem in the past
 (http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43986); currently it
 calls the __free_s_bar_mod_S_bar function instead of the proper
 doit().

Sorry, I don't understand the last sentence. Why should it call some
__free... instead of doit? And why is that test case even affected
by your patch (you said it would only work with explicit DEALLOCATE,
which does not appear in that test case)?


 Regarding typebound_operator_9.f03, I don't know how to fix the patch...

Unfortunately that test case is rather large, so maybe you should
reduce it a bit to find the error (or just do some debugging in order
to find out where exactly it fails). Another possibility: Compare the
dump (using -fdump-tree-original) with and without the patch.


 The patch is written in a raw way due to my newbieness, so any
 suggestion is well accepted.

The patch actually gives a few warnings:

/home/jweil/gcc48/trunk/gcc/fortran/class.c: In function
‘gfc_find_derived_vtab’:
/home/jweil/gcc48/trunk/gcc/fortran/class.c:912:8: warning: ISO C90
forbids mixed declarations and code [-pedantic]
/home/jweil/gcc48/trunk/gcc/fortran/class.c:932:7: warning: C++ style
comments are not allowed in ISO C90 [enabled by default]
/home/jweil/gcc48/trunk/gcc/fortran/class.c:932:7: warning: (this will
be reported only once per input file) [enabled by default]

(and similar things in trans-stmt.c). You should definitely fix those.
Although a non-buildstrap build still works with those warnings, a
full bootstrap will fail.

Cheers,
Janus


Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-02 Thread Alessandro Fanfarillo
Hi Janus,

 Sorry, I don't understand the last sentence. Why should it call some
 __free... instead of doit? And why is that test case even affected
 by your patch (you said it would only work with explicit DEALLOCATE,
 which does not appear in that test case)?

Yes, it is as I said... In
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43986#c4 the doit() call
produces a segfault because r26 is 0 instead of the address of
__s_bar_mod_MOD_doit. With my patched version, the doit call is in
reality a _free __free_s_bar_mod_S_bar call. To better understand I
report a little portion (only the MAIN__) of the fdump-tree-original
and the testcase execution (hoping that it will be understandable...)

MAIN__ ()
{
  struct __class_foo_mod_Foo_p a;
  struct foo b;
  static struct s_bar c = {};
  static struct a_bar d = {};

  try
{
  c.a = 0B;
  d.a.data = 0B;
  (struct __vtype_foo_mod_Foo *) a._vptr = __vtab_foo_mod_Foo;
  a._data = b;
  a._vptr-doit (a);
  if (a._vptr-getit (a) != 1)
{
  _gfortran_abort ();
}
  L.1:;
  (struct __vtype_foo_mod_Foo *) a._vptr = (struct
__vtype_foo_mod_Foo *) __vtab_s_bar_mod_S_bar;
  a._data = (struct foo *) c;
  a._vptr-doit (a); IT REALLY WANTS TO CALL THE DOIT FUNCTION!
  if (a._vptr-getit (a) != 2)
{
  _gfortran_abort ();
}
  L.2:;
  (struct __vtype_foo_mod_Foo *) a._vptr = (struct
__vtype_foo_mod_Foo *) __vtab_a_bar_mod_A_bar;
  a._data = (struct foo *) d;
  a._vptr-doit (a);
  if (a._vptr-getit (a) != 3)
{
  _gfortran_abort ();
}
  L.3:;
}
  finally
{
  if (d.a.data != 0B)
{
  __builtin_free ((void *) d.a.data);
}
  d.a.data = 0B;
  if (c.a != 0B)
{
  __builtin_free ((void *) c.a);
}
  c.a = 0B;
}
}

An now the testcase execution with gdb:

Breakpoint 1, MAIN__ () at dynamic_dispatch_4.f03:82
82type(s_bar), target :: c
(gdb) next
83type(a_bar), target :: d
(gdb)
85a = b
(gdb)
86call a%doit
(gdb)
87if (a%getit () .ne. 1) call abort
(gdb)
88a = c
(gdb) step
89call a%doit
(gdb)
s_bar_mod::__free_s_bar_mod_S_bar (tofree=...) at dynamic_dispatch_4.f03:43
43  class(s_bar) :: a

I don't know if I got it across...

 The patch actually gives a few warnings:

Ok, thanks. I always use bootstrap and it works but I never look at
the compile result (unless it doesn't compile...)


Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-02 Thread Janus Weil
Hi,

 Sorry, I don't understand the last sentence. Why should it call some
 __free... instead of doit? And why is that test case even affected
 by your patch (you said it would only work with explicit DEALLOCATE,
 which does not appear in that test case)?

 Yes, it is as I said... In
 http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43986#c4 the doit() call
 produces a segfault because r26 is 0 instead of the address of
 __s_bar_mod_MOD_doit. With my patched version, the doit call is in
 reality a _free __free_s_bar_mod_S_bar call.

huh, this is strange, indeed. I guess it means that something is
messed up in the vtable (some sort of offset?). We try to call one
virtual function, but we get another. Since this problem was already
seen in PR43986, it is probably a case of your patch uncovering an
existing bug. I'll try to look into this problem soon ...

Cheers,
Janus


Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-02 Thread Tobias Burnus

Janus Weil wrote:

The patch actually gives a few warnings:


Looking at those warnings, they seem to be valid C++ but invalid C89. As 
Stages 2 and 3 are, by default, compiled by C++, I assume that 
Alessandro does not see those.


By contrast, I assume that you (Janus) build GCC with the C compiler, 
i.e. you configure with --disable-build-poststage1-with-cxx.


Thus, a default boot strap,  shouldn't fail. Nonetheless, it is useful 
to keep compatibility with C and bootstrapping with 
--disable-build-poststage1-with-cxx.Hence, the warnings should be fixed. 
(Bootstrapping implies -Werror.)


Tobias


/home/jweil/gcc48/trunk/gcc/fortran/class.c: In function
‘gfc_find_derived_vtab’:
/home/jweil/gcc48/trunk/gcc/fortran/class.c:912:8: warning: ISO C90
forbids mixed declarations and code [-pedantic]
/home/jweil/gcc48/trunk/gcc/fortran/class.c:932:7: warning: C++ style
comments are not allowed in ISO C90 [enabled by default]
/home/jweil/gcc48/trunk/gcc/fortran/class.c:932:7: warning: (this will
be reported only once per input file) [enabled by default]

(and similar things in trans-stmt.c). You should definitely fix those.
Although a non-buildstrap build still works with those warnings, a
full bootstrap will fail.


Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-02 Thread Tobias Burnus

Alessandro Fanfarillo wrote:

The gfortran.dg/dynamic_dispatch_4.f03 had this problem in the past
(http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43986); currently it
calls the __free_s_bar_mod_S_bar function instead of the proper
doit().


That kind of makes sense: foo has no allocatable components while 
s_bar has. Seemingly, foo has no _free component - and thus, the 
first entry in vtab after _hash, _size, _extends, _def_init and _copy 
is doit. However, s_bar has at that position not doit but _free.


My impression is that you do not add a
  _free = null()  (EXPR_NULL)
in the case that there are no allocatable components in the type or its 
parents.


Side note: In class.c, please update the comment at the top by 
mentioning _free after the description of _copy.


Tobias


Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-02 Thread Janus Weil
Hi,

 By contrast, I assume that you (Janus) build GCC with the C compiler, i.e.
 you configure with --disable-build-poststage1-with-cxx.

actually I used --disable-bootstrap, which also has the effect that
gfortran is built with the C compiler.


 Thus, a default boot strap,  shouldn't fail. Nonetheless, it is useful to
 keep compatibility with C and bootstrapping with
 --disable-build-poststage1-with-cxx.Hence, the warnings should be fixed.
 (Bootstrapping implies -Werror.)

Right. I'm not sure what the further plans are for GCC regarding the C
vs C++ issue, but as long as GCC can still be built with a C compiler,
one should probably avoid unnecessary C++isms.

Cheers,
Janus



 /home/jweil/gcc48/trunk/gcc/fortran/class.c: In function
 ‘gfc_find_derived_vtab’:
 /home/jweil/gcc48/trunk/gcc/fortran/class.c:912:8: warning: ISO C90
 forbids mixed declarations and code [-pedantic]
 /home/jweil/gcc48/trunk/gcc/fortran/class.c:932:7: warning: C++ style
 comments are not allowed in ISO C90 [enabled by default]
 /home/jweil/gcc48/trunk/gcc/fortran/class.c:932:7: warning: (this will
 be reported only once per input file) [enabled by default]

 (and similar things in trans-stmt.c). You should definitely fix those.
 Although a non-buildstrap build still works with those warnings, a
 full bootstrap will fail.


Re: [Fortran, DRAFT patch] PR 46321 - [OOP] Polymorphic deallocation

2012-06-02 Thread Janus Weil
2012/6/2 Tobias Burnus bur...@net-b.de:
 Alessandro Fanfarillo wrote:

 The gfortran.dg/dynamic_dispatch_4.f03 had this problem in the past
 (http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43986); currently it
 calls the __free_s_bar_mod_S_bar function instead of the proper
 doit().


 That kind of makes sense: foo has no allocatable components while s_bar
 has. Seemingly, foo has no _free component - and thus, the first entry
 in vtab after _hash, _size, _extends, _def_init and _copy is doit.
 However, s_bar has at that position not doit but _free.

Right, the problem is that the _free component is missing. Just as the
_copy component, _free should be present for *every* vtype, no matter
if there are allocatable components or not. If the _free component is
not needed, it should be initialized to EXPR_NULL.

Cheers,
Janus