diff mbox

[Fortran] PR56845 - Fix setting of vptr of CLASS(...),SAVE,ALLOCATABLE

Message ID 5167CBDE.1000208@net-b.de
State New
Headers show

Commit Message

Tobias Burnus April 12, 2013, 8:54 a.m. UTC 
Am 12.04.2013 08:41, schrieb Janus Weil:
> 2013/4/12 Tobias Burnus <burnus@net-b.de>:
>> I think there was a test-suite failure when I tried it. In any case,
>> variables might be in static memory even if attr.save is not set:
>>
>> - Module variables
>> - Variables of the main program
>> - Local variables of constant size (instead of allocating them on the
>> stack), depending on their size
>> - All local variables with -fno-automatic, which implies SAVE
>> - If "SAVE" has been specified for the scoping unit
> Yes, but for most of them one should have attr.save=SAVE_IMPLICIT (at
> least for #1, #4 and #5?).

(see below)

> And for those that do not have attr.save set, gfc_trans_deferred_vars
> should take care of initializing the vptr already, right? Do we have a
> double initlialization for these cases now?

Well, the new code looks as follows - thus, there should be not a double 
initialization:

       if (sym->ts.type == BT_CLASS && TREE_STATIC (sym->backend_decl)
           && CLASS_DATA (sym)->attr.allocatable)
...
       else if (sym->attr.dimension || sym->attr.codimension)
       else if ((!sym->attr.dummy || sym->ts.deferred)
                 && (sym->ts.type == BT_CLASS
                 && CLASS_DATA (sym)->attr.class_pointer))
         continue;
       else if ((!sym->attr.dummy || sym->ts.deferred)
                 && (sym->attr.allocatable
                     || (sym->ts.type == BT_CLASS
                         && CLASS_DATA (sym)->attr.allocatable)))
         {
           if (!sym->attr.save && gfc_option.flag_max_stack_var_size != 0)

and a bunch of more "else if".


  * * *

Actually, after committing the patch, I realized that the code above not 
only disables the double assignment but also the deallocate. Thus, for 
-fmax-stack-var-size=1 one has no deallocation - and, thus, the vptr 
might be wrong (it would be set by deallocate, which is not called).

I have now moved to the proposed
    sym->attr.save || gfc_option.flag_max_stack_var_size == 0
instead of
   TREE_STATIC (sym->backend_decl)

Thus, you were on the right track!


[Pointers]
> Ok, I guess one could argue that it could not hurt to do the 
> initialization for pointers, too. But since the standard does not 
> seems to require it, let's forget about it.

At some point, I'd like to have some pointer-is-uninitialized check; for 
that one initializes the pointer with a bogus value and checks at 
run-time whether it has that value, which implies that it is 
uninitialized. Otherwise, static variables have data == NULL by default 
(.bss section of the assembler file, not needed for Fortran but still used).

Thanks for the review - and for asking the right questions.

Committed as Rev. 197844 and the attached follow-up patch as Rev. 197848.

Tobias
diff mbox

Patch

2013-04-12  Tobias Burnus  <burnus@net-b.de>

	PR fortran/56845
	* trans-decl.c (gfc_trans_deferred_vars): Restrict
	static CLASS init to SAVE and -fno-automatic.

2013-04-12  Tobias Burnus  <burnus@net-b.de>

	PR fortran/56845
	* gfortran.dg/class_allocate_15.f90: New.

	Revert:
	2013-04-12  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/coarray_lib_alloc_2.f90: Update
	scan-tree-dump-times.

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 779df16..f2cf2de 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3649,7 +3649,8 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 				NULL_TREE);
 	}
 
-      if (sym->ts.type == BT_CLASS && TREE_STATIC (sym->backend_decl)
+      if (sym->ts.type == BT_CLASS
+	  && (sym->attr.save || gfc_option.flag_max_stack_var_size == 0)
 	  && CLASS_DATA (sym)->attr.allocatable)
 	{
 	  tree vptr;
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90
index a41be79..3aaff1e 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_alloc_2.f90
@@ -18,6 +18,6 @@ 
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_register .1, 1, &yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, &stat.., &errmsg, 200.;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 0 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 0 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&yy._data.token, 0B, 0B, 0.;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister .&xx._data.token, 0B, 0B, 0.;" 1 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
--- /dev/null	2013-04-12 09:16:45.096038934 +0200
+++ gcc/gcc/testsuite/gfortran.dg/class_allocate_15.f90	2013-04-12 10:34:38.982753620 +0200
@@ -0,0 +1,28 @@ 
+! { dg-do run }
+! { dg-options "-fdump-tree-original -fdump-tree-original -fmax-stack-var-size=1" }
+!
+! PR fortran/56845
+!
+type t
+end type t
+type, extends(t) :: t2
+end type t2
+type(t) :: y
+call foo()
+call bar()
+contains
+  subroutine foo()
+    class(t), allocatable :: x
+    if(allocated(x)) call abort()
+    if(.not.same_type_as(x,y)) call abort()
+    allocate (t2 :: x)
+  end
+  subroutine bar()
+    class(t), allocatable :: x(:)
+    if(allocated(x)) call abort()
+    if(.not.same_type_as(x,y)) call abort()
+    allocate (t2 :: x(4))
+  end
+end
+! { dg-final { scan-tree-dump-times "__builtin_free" 2 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }