Message ID | 20150226181717.480e282c@vepi2 |
---|---|
State | New |
Headers | show |
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
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
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
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
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.
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 --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; }