diff mbox

[1/2,Fortran,pr60322,OOP] Incorrect bounds on polymorphic dummy array

Message ID 20150226181717.480e282c@vepi2
State New
Headers show

Commit Message

Andre Vehreschild Feb. 26, 2015, 5:17 p.m. UTC 
Hi all,

please find attached the first part of a two parts patch fixing pr/60322. This
first patch is only preparatory and does not change any of the semantics of
gfortran at all. It only modifies the compiler code to have the
symbol_attribute and the gfc_array_spec in a separate variable in the some
routines. The second part of the patch will then initialize these variables with
either the (sym.attr and sym.as) or (CLASS_DATA(sym).attr and
CLASS_DATA(sym).as), respectively, depending on whether the current symbol is
a regular array or a class array.

Bootstraps and regtests ok on x86_64-linux-gnu/F20.

Regards,
	Andre

Comments

Mikael Morin March 23, 2015, 12:28 p.m. UTC | #1 
26/02/2015 18:17, Andre Vehreschild a écrit :
> This first patch is only preparatory and does not change any of the semantics of
> gfortran at all.
Sure?

> diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
> index ab6f7a5..d28cf77 100644
> --- a/gcc/fortran/expr.c
> +++ b/gcc/fortran/expr.c
> @@ -4059,10 +4060,10 @@ gfc_lval_expr_from_sym (gfc_symbol *sym)
>    lval->symtree = gfc_find_symtree (sym->ns->sym_root, sym->name);
>  
>    /* It will always be a full array.  */
> -  lval->rank = sym->as ? sym->as->rank : 0;
> +  as = sym->as;
> +  lval->rank = as ? as->rank : 0;
>    if (lval->rank)
> -    gfc_add_full_array_ref (lval, sym->ts.type == BT_CLASS ?
> -			    CLASS_DATA (sym)->as : sym->as);
> +    gfc_add_full_array_ref (lval, as);

This is a change of semantics.  Or do you know that sym->ts.type !=
BT_CLASS?


> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
> index 3664824..e571a17 100644
> --- a/gcc/fortran/trans-decl.c
> +++ b/gcc/fortran/trans-decl.c
> @@ -1013,16 +1017,24 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
>    tree decl;
>    tree type;
>    gfc_array_spec *as;
> +  symbol_attribute *array_attr;
>    char *name;
>    gfc_packed packed;
>    int n;
>    bool known_size;
>  
> -  if (sym->attr.pointer || sym->attr.allocatable
> -      || (sym->as && sym->as->type == AS_ASSUMED_RANK))
> +  /* Use the array as and attr.  */
> +  as = sym->as;
> +  array_attr = &sym->attr;
> +
> +  /* The pointer attribute is always set on a _data component, therefore check
> +     the sym's attribute only.  */
> +  if (sym->attr.pointer || array_attr->allocatable
> +      || (as && as->type == AS_ASSUMED_RANK))
>      return dummy;
>  
Any reason to sometimes use array_attr, sometimes not, like here?
By the way, the comment is misleading: for classes, there is the
class_pointer attribute (and it is a pain, I know).

Mikael
Andre Vehreschild March 23, 2015, 12:43 p.m. UTC | #2 
Hi Mikael,

thanks for looking at the patch. Please note, that Paul has sent an addendum to
the patches for 60322, which I deliberately have attached.

>  26/02/2015 18:17, Andre Vehreschild a écrit :
> > This first patch is only preparatory and does not change any of the
> > semantics of gfortran at all.
> Sure?

With the counterexample you found below, this of course is a wrong statement.
 
> > diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
> > index ab6f7a5..d28cf77 100644
> > --- a/gcc/fortran/expr.c
> > +++ b/gcc/fortran/expr.c
> > @@ -4059,10 +4060,10 @@ gfc_lval_expr_from_sym (gfc_symbol *sym)
> >    lval->symtree = gfc_find_symtree (sym->ns->sym_root, sym->name);
> >  
> >    /* It will always be a full array.  */
> > -  lval->rank = sym->as ? sym->as->rank : 0;
> > +  as = sym->as;
> > +  lval->rank = as ? as->rank : 0;
> >    if (lval->rank)
> > -    gfc_add_full_array_ref (lval, sym->ts.type == BT_CLASS ?
> > -			    CLASS_DATA (sym)->as : sym->as);
> > +    gfc_add_full_array_ref (lval, as);
> 
> This is a change of semantics.  Or do you know that sym->ts.type !=
> BT_CLASS?

You are completely right. I have made a mistake here. I have to tell the truth,
I never ran a regtest with only part 1 of the patches applied. The second part
of the patch will correct this, by setting the variable as depending on whether
type == BT_CLASS or not. Sorry for the mistake.

> > diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
> > index 3664824..e571a17 100644
> > --- a/gcc/fortran/trans-decl.c
> > +++ b/gcc/fortran/trans-decl.c
> > @@ -1013,16 +1017,24 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree
> > dummy) tree decl;
> >    tree type;
> >    gfc_array_spec *as;
> > +  symbol_attribute *array_attr;
> >    char *name;
> >    gfc_packed packed;
> >    int n;
> >    bool known_size;
> >  
> > -  if (sym->attr.pointer || sym->attr.allocatable
> > -      || (sym->as && sym->as->type == AS_ASSUMED_RANK))
> > +  /* Use the array as and attr.  */
> > +  as = sym->as;
> > +  array_attr = &sym->attr;
> > +
> > +  /* The pointer attribute is always set on a _data component, therefore
> > check
> > +     the sym's attribute only.  */
> > +  if (sym->attr.pointer || array_attr->allocatable
> > +      || (as && as->type == AS_ASSUMED_RANK))
> >      return dummy;
> >  
> Any reason to sometimes use array_attr, sometimes not, like here?
> By the way, the comment is misleading: for classes, there is the
> class_pointer attribute (and it is a pain, I know).

Yes, and a good one. Array_attr is sometimes sym->attr and sometimes
CLASS_DATA(sym)->attr aka sym->ts.u.derived->components->attr. In the later
case .pointer is always set to 1 in the _data component's attr. I.e., the above
if, would always yield true for a class_array, which is not intended, but rather
destructive. I know about the class_pointer attribute, but I figured, that it
is not relevant here. Any idea how to formulate the comment better, to reflect
what I just explained?

Regards,
	Andre
Mikael Morin March 23, 2015, 2:57 p.m. UTC | #3 
Le 23/03/2015 13:43, Andre Vehreschild a écrit :
> Hi Mikael,
> 
> thanks for looking at the patch. Please note, that Paul has sent an addendum to
> the patches for 60322, which I deliberately have attached.
> 
>>  26/02/2015 18:17, Andre Vehreschild a écrit :
>>> This first patch is only preparatory and does not change any of the
>>> semantics of gfortran at all.
>> Sure?
> 
> With the counterexample you found below, this of course is a wrong statement.
>  
>>> diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
>>> index ab6f7a5..d28cf77 100644
>>> --- a/gcc/fortran/expr.c
>>> +++ b/gcc/fortran/expr.c
>>> @@ -4059,10 +4060,10 @@ gfc_lval_expr_from_sym (gfc_symbol *sym)
>>>    lval->symtree = gfc_find_symtree (sym->ns->sym_root, sym->name);
>>>  
>>>    /* It will always be a full array.  */
>>> -  lval->rank = sym->as ? sym->as->rank : 0;
>>> +  as = sym->as;
>>> +  lval->rank = as ? as->rank : 0;
>>>    if (lval->rank)
>>> -    gfc_add_full_array_ref (lval, sym->ts.type == BT_CLASS ?
>>> -			    CLASS_DATA (sym)->as : sym->as);
>>> +    gfc_add_full_array_ref (lval, as);
>>
>> This is a change of semantics.  Or do you know that sym->ts.type !=
>> BT_CLASS?
> 
> You are completely right. I have made a mistake here. I have to tell the truth,
> I never ran a regtest with only part 1 of the patches applied. The second part
> of the patch will correct this, by setting the variable as depending on whether
> type == BT_CLASS or not. Sorry for the mistake.
> 
>>> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
>>> index 3664824..e571a17 100644
>>> --- a/gcc/fortran/trans-decl.c
>>> +++ b/gcc/fortran/trans-decl.c
>>> @@ -1013,16 +1017,24 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree
>>> dummy) tree decl;
>>>    tree type;
>>>    gfc_array_spec *as;
>>> +  symbol_attribute *array_attr;
>>>    char *name;
>>>    gfc_packed packed;
>>>    int n;
>>>    bool known_size;
>>>  
>>> -  if (sym->attr.pointer || sym->attr.allocatable
>>> -      || (sym->as && sym->as->type == AS_ASSUMED_RANK))
>>> +  /* Use the array as and attr.  */
>>> +  as = sym->as;
>>> +  array_attr = &sym->attr;
>>> +
>>> +  /* The pointer attribute is always set on a _data component, therefore
>>> check
>>> +     the sym's attribute only.  */
>>> +  if (sym->attr.pointer || array_attr->allocatable
>>> +      || (as && as->type == AS_ASSUMED_RANK))
>>>      return dummy;
>>>  
>> Any reason to sometimes use array_attr, sometimes not, like here?
>> By the way, the comment is misleading: for classes, there is the
>> class_pointer attribute (and it is a pain, I know).
> 
> Yes, and a good one. Array_attr is sometimes sym->attr and sometimes
> CLASS_DATA(sym)->attr aka sym->ts.u.derived->components->attr. In the later
> case .pointer is always set to 1 in the _data component's attr. I.e., the above
> if, would always yield true for a class_array, which is not intended, but rather
> destructive. I know about the class_pointer attribute, but I figured, that it
> is not relevant here. Any idea how to formulate the comment better, to reflect
> what I just explained?
> 
This pointer stuff is very difficult to swallow to me.
I understand that for classes, the CLASS_DATA (sym)->pointer is always
set, but almost everywhere the checks for pointerness are like
  (sym->ts.type != BT_CLASS && sym->attr.pointer)
  || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.class_pointer)
and I don't see a convincing reason to have it different here.

At least gfc_is_nodesc_array should return 0 if sym->ts.type == BT_CLASS
which solves the problem there; for the other cases, I think that
class_pointer should be looked at.  gfc_build_class_symbol  clears the
sym->attr.pointer flag for class containers so it doesn't make sense to
test that flag.

Mikael
Andre Vehreschild March 23, 2015, 3:49 p.m. UTC | #4 
Hi Mikael, 

> This pointer stuff is very difficult to swallow to me.

I totally understand. When doing the patch I had to restart twice, because I
mixed up the development on the class arrays so completely, that I couldn't get
it right again.

> I understand that for classes, the CLASS_DATA (sym)->pointer is always
> set, but almost everywhere the checks for pointerness are like
>   (sym->ts.type != BT_CLASS && sym->attr.pointer)
>   || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.class_pointer)
> and I don't see a convincing reason to have it different here.

I see your point. Currently I am bootstraping and regtesting some patches for
commit. While this is running, my machine is nearly unusable. I will look into
this as soon, as my machine allows, but probably not before tomorrow.
 
> At least gfc_is_nodesc_array should return 0 if sym->ts.type == BT_CLASS
> which solves the problem there; for the other cases, I think that
> class_pointer should be looked at.  gfc_build_class_symbol  clears the
> sym->attr.pointer flag for class containers so it doesn't make sense to
> test that flag.

Completely right again. But I figured, that because sym->attr.pointer is never
set for BT_CLASS there is no harm to check it and furthermore no need to guard
it by checking whether ts.type == BT_CLASS. Fortunately not checking for
class_pointer in _data's attr, didn't throw any regressions. Thinking about it
now, I also think that it is probably safer to add the check for the
class_pointer attribute were attr.pointer is checked on the sym, having the
expression like you pointed out:

>   (sym->ts.type != BT_CLASS && sym->attr.pointer)
>   || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.class_pointer)

Regards,
	Andre
Mikael Morin March 23, 2015, 7:28 p.m. UTC | #5 
Le 23/03/2015 16:49, Andre Vehreschild a écrit :
> I see your point. Currently I am bootstraping and regtesting some patches for
> commit. While this is running, my machine is nearly unusable. I will look into
> this as soon, as my machine allows, but probably not before tomorrow.
> 
There is no hurry, the patch(es) will probably have to wait for next
stage 1.
Paul Richard Thomas March 24, 2015, 10:13 a.m. UTC | #6 
Dear Andre,

Dominique pointed out to me that the 'loc' patch causes a ICE in the
testsuite. It seems that 'loc' should provide the address of the class
container in some places and the address of the data in others. I will
put my thinking cap on tonight :-)

Cheers

Paul

On 23 March 2015 at 13:43, Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Mikael,
>
> thanks for looking at the patch. Please note, that Paul has sent an addendum to
> the patches for 60322, which I deliberately have attached.
>
>>  26/02/2015 18:17, Andre Vehreschild a écrit :
>> > This first patch is only preparatory and does not change any of the
>> > semantics of gfortran at all.
>> Sure?
>
> With the counterexample you found below, this of course is a wrong statement.
>
>> > diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
>> > index ab6f7a5..d28cf77 100644
>> > --- a/gcc/fortran/expr.c
>> > +++ b/gcc/fortran/expr.c
>> > @@ -4059,10 +4060,10 @@ gfc_lval_expr_from_sym (gfc_symbol *sym)
>> >    lval->symtree = gfc_find_symtree (sym->ns->sym_root, sym->name);
>> >
>> >    /* It will always be a full array.  */
>> > -  lval->rank = sym->as ? sym->as->rank : 0;
>> > +  as = sym->as;
>> > +  lval->rank = as ? as->rank : 0;
>> >    if (lval->rank)
>> > -    gfc_add_full_array_ref (lval, sym->ts.type == BT_CLASS ?
>> > -                       CLASS_DATA (sym)->as : sym->as);
>> > +    gfc_add_full_array_ref (lval, as);
>>
>> This is a change of semantics.  Or do you know that sym->ts.type !=
>> BT_CLASS?
>
> You are completely right. I have made a mistake here. I have to tell the truth,
> I never ran a regtest with only part 1 of the patches applied. The second part
> of the patch will correct this, by setting the variable as depending on whether
> type == BT_CLASS or not. Sorry for the mistake.
>
>> > diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
>> > index 3664824..e571a17 100644
>> > --- a/gcc/fortran/trans-decl.c
>> > +++ b/gcc/fortran/trans-decl.c
>> > @@ -1013,16 +1017,24 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree
>> > dummy) tree decl;
>> >    tree type;
>> >    gfc_array_spec *as;
>> > +  symbol_attribute *array_attr;
>> >    char *name;
>> >    gfc_packed packed;
>> >    int n;
>> >    bool known_size;
>> >
>> > -  if (sym->attr.pointer || sym->attr.allocatable
>> > -      || (sym->as && sym->as->type == AS_ASSUMED_RANK))
>> > +  /* Use the array as and attr.  */
>> > +  as = sym->as;
>> > +  array_attr = &sym->attr;
>> > +
>> > +  /* The pointer attribute is always set on a _data component, therefore
>> > check
>> > +     the sym's attribute only.  */
>> > +  if (sym->attr.pointer || array_attr->allocatable
>> > +      || (as && as->type == AS_ASSUMED_RANK))
>> >      return dummy;
>> >
>> Any reason to sometimes use array_attr, sometimes not, like here?
>> By the way, the comment is misleading: for classes, there is the
>> class_pointer attribute (and it is a pain, I know).
>
> Yes, and a good one. Array_attr is sometimes sym->attr and sometimes
> CLASS_DATA(sym)->attr aka sym->ts.u.derived->components->attr. In the later
> case .pointer is always set to 1 in the _data component's attr. I.e., the above
> if, would always yield true for a class_array, which is not intended, but rather
> destructive. I know about the class_pointer attribute, but I figured, that it
> is not relevant here. Any idea how to formulate the comment better, to reflect
> what I just explained?
>
> Regards,
>         Andre
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
>
>
> ---------- Forwarded message ----------
> From: Paul Richard Thomas <paul.richard.thomas@gmail.com>
> To: Andre Vehreschild <vehre@gmx.de>, Dominique Dhumieres <dominiq@lps.ens.fr>
> Cc:
> Date: Sun, 22 Mar 2015 21:20:20 +0100
> Subject: Bug in intrinsic LOC for scalar class objects
> Dear Andre and Dominique,
>
> I have found that LOC is returning the address of the class container
> rather than the _data component for class scalars. See the source
> below, which you will recognise! A fix is attached.
>
> Note that the scalar allocate fails with MOLD= and so I substituted SOURCE=.
>
> Cheers
>
> Paul
>
>     class(*), allocatable :: a(:), e ! Change 'e' to an array and
> second memcpy works correctly
>                                      ! Problem is with loc(e), which
> returns the address of the
>                                      ! class container.
>     allocate (e, source = 99.0)
>     allocate (a(2), source = [1.0, 2.0])
>     call add_element_poly (a,e)
>     select type (a)
>       type is (real)
>         print *, a
>     end select
>
> contains
>
>     subroutine add_element_poly(a,e)
>       use iso_c_binding
>       class(*),allocatable,intent(inout),target :: a(:)
>       class(*),intent(in),target :: e
>       class(*),allocatable,target :: tmp(:)
>       type(c_ptr) :: dummy
>
>       interface
>         function memcpy(dest,src,n) bind(C,name="memcpy") result(res)
>           import
>           type(c_ptr) :: res
>           integer(c_intptr_t),value :: dest
>           integer(c_intptr_t),value :: src
>           integer(c_size_t),value :: n
>         end function
>       end interface
>
>       if (.not.allocated(a)) then
>         allocate(a(1), source=e)
>       else
>         allocate(tmp(size(a)),source=a)
>         deallocate(a)
>         allocate(a(size(tmp)+1),source=e) ! mold gives a segfault
>         dummy = memcpy(loc(a(1)),loc(tmp),sizeof(tmp))
>         dummy = memcpy(loc(a(size(tmp)+1)),loc(e),sizeof(e))
>       end if
>     end subroutine
> end
>
diff mbox

Patch

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index ab6f7a5..d28cf77 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4052,6 +4052,7 @@  gfc_expr *
 gfc_lval_expr_from_sym (gfc_symbol *sym)
 {
   gfc_expr *lval;
+  gfc_array_spec *as;
   lval = gfc_get_expr ();
   lval->expr_type = EXPR_VARIABLE;
   lval->where = sym->declared_at;
@@ -4059,10 +4060,10 @@  gfc_lval_expr_from_sym (gfc_symbol *sym)
   lval->symtree = gfc_find_symtree (sym->ns->sym_root, sym->name);
 
   /* It will always be a full array.  */
-  lval->rank = sym->as ? sym->as->rank : 0;
+  as = sym->as;
+  lval->rank = as ? as->rank : 0;
   if (lval->rank)
-    gfc_add_full_array_ref (lval, sym->ts.type == BT_CLASS ?
-			    CLASS_DATA (sym)->as : sym->as);
+    gfc_add_full_array_ref (lval, as);
   return lval;
 }
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 642110d..0d4d7b2 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5898,6 +5898,7 @@  gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
   int checkparm;
   int no_repack;
   bool optional_arg;
+  gfc_array_spec *as;
 
   /* Do nothing for pointer and allocatable arrays.  */
   if (sym->attr.pointer || sym->attr.allocatable)
@@ -5917,13 +5918,14 @@  gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
   gcc_assert (GFC_ARRAY_TYPE_P (type));
   dumdesc = GFC_DECL_SAVED_DESCRIPTOR (tmpdesc);
   dumdesc = build_fold_indirect_ref_loc (input_location, dumdesc);
+  as = sym->as;
   gfc_start_block (&init);
 
   if (sym->ts.type == BT_CHARACTER
       && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)
     gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
 
-  checkparm = (sym->as->type == AS_EXPLICIT
+  checkparm = (as->type == AS_EXPLICIT
 	       && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS));
 
   no_repack = !(GFC_DECL_PACKED_ARRAY (tmpdesc)
@@ -5999,9 +6001,9 @@  gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
   size = gfc_index_one_node;
 
   /* Evaluate the bounds of the array.  */
-  for (n = 0; n < sym->as->rank; n++)
+  for (n = 0; n < as->rank; n++)
     {
-      if (checkparm || !sym->as->upper[n])
+      if (checkparm || !as->upper[n])
 	{
 	  /* Get the bounds of the actual parameter.  */
 	  dubound = gfc_conv_descriptor_ubound_get (dumdesc, gfc_rank_cst[n]);
@@ -6017,7 +6019,7 @@  gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
       if (!INTEGER_CST_P (lbound))
 	{
 	  gfc_init_se (&se, NULL);
-	  gfc_conv_expr_type (&se, sym->as->lower[n],
+	  gfc_conv_expr_type (&se, as->lower[n],
 			      gfc_array_index_type);
 	  gfc_add_block_to_block (&init, &se.pre);
 	  gfc_add_modify (&init, lbound, se.expr);
@@ -6025,13 +6027,13 @@  gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
 
       ubound = GFC_TYPE_ARRAY_UBOUND (type, n);
       /* Set the desired upper bound.  */
-      if (sym->as->upper[n])
+      if (as->upper[n])
 	{
 	  /* We know what we want the upper bound to be.  */
 	  if (!INTEGER_CST_P (ubound))
 	    {
 	      gfc_init_se (&se, NULL);
-	      gfc_conv_expr_type (&se, sym->as->upper[n],
+	      gfc_conv_expr_type (&se, as->upper[n],
 				  gfc_array_index_type);
 	      gfc_add_block_to_block (&init, &se.pre);
 	      gfc_add_modify (&init, ubound, se.expr);
@@ -6084,7 +6086,7 @@  gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
 				gfc_array_index_type, offset, tmp);
 
       /* The size of this dimension, and the stride of the next.  */
-      if (n + 1 < sym->as->rank)
+      if (n + 1 < as->rank)
 	{
 	  stride = GFC_TYPE_ARRAY_STRIDE (type, n + 1);
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 3664824..e571a17 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -811,8 +811,12 @@  gfc_build_qualified_array (tree decl, gfc_symbol * sym)
   int dim;
   int nest;
   gfc_namespace* procns;
+  symbol_attribute *array_attr;
+  gfc_array_spec *as;
 
   type = TREE_TYPE (decl);
+  array_attr = &sym->attr;
+  as = sym->as;
 
   /* We just use the descriptor, if there is one.  */
   if (GFC_DESCRIPTOR_TYPE_P (type))
@@ -823,8 +827,8 @@  gfc_build_qualified_array (tree decl, gfc_symbol * sym)
   nest = (procns->proc_name->backend_decl != current_function_decl)
 	 && !sym->attr.contained;
 
-  if (sym->attr.codimension && flag_coarray == GFC_FCOARRAY_LIB
-      && sym->as->type != AS_ASSUMED_SHAPE
+  if (array_attr->codimension && flag_coarray == GFC_FCOARRAY_LIB
+      && as->type != AS_ASSUMED_SHAPE
       && GFC_TYPE_ARRAY_CAF_TOKEN (type) == NULL_TREE)
     {
       tree token;
@@ -877,8 +881,8 @@  gfc_build_qualified_array (tree decl, gfc_symbol * sym)
 	}
       /* Don't try to use the unknown bound for assumed shape arrays.  */
       if (GFC_TYPE_ARRAY_UBOUND (type, dim) == NULL_TREE
-          && (sym->as->type != AS_ASSUMED_SIZE
-              || dim < GFC_TYPE_ARRAY_RANK (type) - 1))
+	  && (as->type != AS_ASSUMED_SIZE
+	      || dim < GFC_TYPE_ARRAY_RANK (type) - 1))
 	{
 	  GFC_TYPE_ARRAY_UBOUND (type, dim) = create_index_var ("ubound", nest);
 	  TREE_NO_WARNING (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 1;
@@ -919,7 +923,7 @@  gfc_build_qualified_array (tree decl, gfc_symbol * sym)
     }
 
   if (GFC_TYPE_ARRAY_SIZE (type) == NULL_TREE
-      && sym->as->type != AS_ASSUMED_SIZE)
+      && as->type != AS_ASSUMED_SIZE)
     {
       GFC_TYPE_ARRAY_SIZE (type) = create_index_var ("size", nest);
       TREE_NO_WARNING (GFC_TYPE_ARRAY_SIZE (type)) = 1;
@@ -946,12 +950,12 @@  gfc_build_qualified_array (tree decl, gfc_symbol * sym)
     }
 
   if (TYPE_NAME (type) != NULL_TREE
-      && GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1) != NULL_TREE
-      && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1)) == VAR_DECL)
+      && GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1) != NULL_TREE
+      && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1)) == VAR_DECL)
     {
       tree gtype = DECL_ORIGINAL_TYPE (TYPE_NAME (type));
 
-      for (dim = 0; dim < sym->as->rank - 1; dim++)
+      for (dim = 0; dim < as->rank - 1; dim++)
 	{
 	  gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE);
 	  gtype = TREE_TYPE (gtype);
@@ -965,7 +969,7 @@  gfc_build_qualified_array (tree decl, gfc_symbol * sym)
     {
       tree gtype = TREE_TYPE (type), rtype, type_decl;
 
-      for (dim = sym->as->rank - 1; dim >= 0; dim--)
+      for (dim = as->rank - 1; dim >= 0; dim--)
 	{
 	  tree lbound, ubound;
 	  lbound = GFC_TYPE_ARRAY_LBOUND (type, dim);
@@ -1013,16 +1017,24 @@  gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
   tree decl;
   tree type;
   gfc_array_spec *as;
+  symbol_attribute *array_attr;
   char *name;
   gfc_packed packed;
   int n;
   bool known_size;
 
-  if (sym->attr.pointer || sym->attr.allocatable
-      || (sym->as && sym->as->type == AS_ASSUMED_RANK))
+  /* Use the array as and attr.  */
+  as = sym->as;
+  array_attr = &sym->attr;
+
+  /* The pointer attribute is always set on a _data component, therefore check
+     the sym's attribute only.  */
+  if (sym->attr.pointer || array_attr->allocatable
+      || (as && as->type == AS_ASSUMED_RANK))
     return dummy;
 
-  /* Add to list of variables if not a fake result variable.  */
+  /* Add to list of variables if not a fake result variable.
+     These symbols are set on the symbol only, not on the class component.  */
   if (sym->attr.result || sym->attr.dummy)
     gfc_defer_symbol_init (sym);
 
@@ -1047,7 +1059,6 @@  gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
   if (GFC_DESCRIPTOR_TYPE_P (type))
     {
       /* Create a descriptorless array pointer.  */
-      as = sym->as;
       packed = PACKED_NO;
 
       /* Even when -frepack-arrays is used, symbols with TARGET attribute
@@ -1079,7 +1090,7 @@  gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
 	}
 
       type = gfc_typenode_for_spec (&sym->ts);
-      type = gfc_get_nodesc_array_type (type, sym->as, packed,
+      type = gfc_get_nodesc_array_type (type, as, packed,
 					!sym->attr.target);
     }
   else
@@ -1109,7 +1120,7 @@  gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
 
   /* We should never get deferred shape arrays here.  We used to because of
      frontend bugs.  */
-  gcc_assert (sym->as->type != AS_DEFERRED);
+  gcc_assert (as->type != AS_DEFERRED);
 
   if (packed == PACKED_PARTIAL)
     GFC_DECL_PARTIAL_PACKED_ARRAY (decl) = 1;
@@ -3973,16 +3984,25 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	}
       else if (sym->attr.dimension || sym->attr.codimension)
 	{
-          /* Assumed-size Cray pointees need to be treated as AS_EXPLICIT.  */
-          array_type tmp = sym->as->type;
-          if (tmp == AS_ASSUMED_SIZE && sym->as->cp_was_assumed)
-            tmp = AS_EXPLICIT;
-          switch (tmp)
+	  symbol_attribute *array_attr;
+	  gfc_array_spec *as;
+	  array_type tmp;
+
+	  array_attr = &sym->attr;
+	  as = sym->as;
+	  /* Assumed-size Cray pointees need to be treated as AS_EXPLICIT.  */
+	  tmp = as->type;
+	  if (tmp == AS_ASSUMED_SIZE && as->cp_was_assumed)
+	    tmp = AS_EXPLICIT;
+	  switch (tmp)
 	    {
 	    case AS_EXPLICIT:
 	      if (sym->attr.dummy || sym->attr.result)
 		gfc_trans_dummy_array_bias (sym, sym->backend_decl, block);
-	      else if (sym->attr.pointer || sym->attr.allocatable)
+	      /* In a class array the _data component always has the pointer
+		 attribute set.  Therefore only check for allocatable in the
+		 array attributes and for pointer in the symbol.  */
+	      else if (sym->attr.pointer || array_attr->allocatable)
 		{
 		  if (TREE_STATIC (sym->backend_decl))
 		    {
@@ -3997,7 +4017,8 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 		      gfc_trans_deferred_array (sym, block);
 		    }
 		}
-	      else if (sym->attr.codimension && TREE_STATIC (sym->backend_decl))
+	      else if (sym->attr.codimension
+		       && TREE_STATIC (sym->backend_decl))
 		{
 		  gfc_init_block (&tmpblock);
 		  gfc_trans_array_cobounds (TREE_TYPE (sym->backend_decl),
@@ -4036,7 +4057,7 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 
 	    case AS_ASSUMED_SIZE:
 	      /* Must be a dummy parameter.  */
-	      gcc_assert (sym->attr.dummy || sym->as->cp_was_assumed);
+	      gcc_assert (sym->attr.dummy || as->cp_was_assumed);
 
 	      /* We should always pass assumed size arrays the g77 way.  */
 	      if (sym->attr.dummy)
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 53da053..bce4d24 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1288,25 +1288,32 @@  gfc_get_element_type (tree type)
 int
 gfc_is_nodesc_array (gfc_symbol * sym)
 {
-  gcc_assert (sym->attr.dimension || sym->attr.codimension);
+  symbol_attribute *array_attr;
+  gfc_array_spec *as;
+
+  array_attr = &sym->attr;
+  as = sym->as;
+
+  gcc_assert (array_attr->dimension || array_attr->codimension);
 
   /* We only want local arrays.  */
-  if (sym->attr.pointer || sym->attr.allocatable)
+  if (sym->attr.pointer || array_attr->allocatable)
     return 0;
 
   /* We want a descriptor for associate-name arrays that do not have an
-     explicitly known shape already.  */
-  if (sym->assoc && sym->as->type != AS_EXPLICIT)
+	 explicitly known shape already.  */
+  if (sym->assoc && as->type != AS_EXPLICIT)
     return 0;
 
+  /* The dummy is stored in sym and not in the component.  */
   if (sym->attr.dummy)
-    return sym->as->type != AS_ASSUMED_SHAPE
-	   && sym->as->type != AS_ASSUMED_RANK;
+    return as->type != AS_ASSUMED_SHAPE
+	&& as->type != AS_ASSUMED_RANK;
 
   if (sym->attr.result || sym->attr.function)
     return 0;
 
-  gcc_assert (sym->as->type == AS_EXPLICIT || sym->as->cp_was_assumed);
+  gcc_assert (as->type == AS_EXPLICIT || as->cp_was_assumed);
 
   return 1;
 }