@@ -850,9 +850,6 @@ typedef struct
/* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */
unsigned ext_attr:EXT_ATTR_NUM;
- /* Is a parameter associated with a deferred type component. */
- unsigned deferred_parameter:1;
-
/* The namespace where the attribute has been set. */
struct gfc_namespace *volatile_ns, *asynchronous_ns;
}
@@ -2379,7 +2379,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
"structure constructor at %C", comp->name))
return false;
}
- else if (!comp->attr.deferred_parameter)
+ else if (!comp->attr.artificial)
{
gfc_error ("No initializer for component %qs given in the"
" structure constructor at %C!", comp->name);
@@ -2461,7 +2461,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
{
/* Components without name are not allowed after the first named
component initializer! */
- if (!comp || comp->attr.deferred_parameter)
+ if (!comp || comp->attr.artificial)
{
if (last_name)
gfc_error ("Component initializer without name after component"
@@ -12653,7 +12653,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
strlen->ts.type = BT_INTEGER;
strlen->ts.kind = gfc_charlen_int_kind;
strlen->attr.access = ACCESS_PRIVATE;
- strlen->attr.deferred_parameter = 1;
+ strlen->attr.artificial = 1;
}
}
@@ -1951,7 +1952,10 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
se->expr = tmp;
- if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer)
+ /* Allocatable deferred char arrays are to be handled by the gfc_deferred_
+ strlen () conditional below. */
+ if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer
+ && !(c->attr.allocatable && c->ts.deferred))
{
tmp = c->ts.u.cl->backend_decl;
/* Components must always be constant length. */
@@ -6550,7 +6553,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
gfc_add_expr_to_block (&block, tmp);
}
}
- else if (!cm->attr.deferred_parameter)
+ else if (!cm->attr.artificial)
{
/* Scalar component (excluding deferred parameters). */
gfc_init_se (&se, NULL);
@@ -1101,12 +1101,7 @@ gfc_typenode_for_spec (gfc_typespec * spec)
break;
case BT_CHARACTER:
-#if 0
- if (spec->deferred)
- basetype = gfc_get_character_type (spec->kind, NULL);
- else
-#endif
- basetype = gfc_get_character_type (spec->kind, spec->u.cl);
+ basetype = gfc_get_character_type (spec->kind, spec->u.cl);
break;
case BT_HOLLERITH:
@@ -2150,9 +2145,11 @@ gfc_sym_type (gfc_symbol * sym)
if (sym->ts.type == BT_CHARACTER
&& ((sym->attr.function && sym->attr.is_bind_c)
|| (sym->attr.result
&& sym->ns->proc_name
- && sym->ns->proc_name->attr.is_bind_c)))
+ && sym->ns->proc_name->attr.is_bind_c)
+ || (sym->ts.deferred && (!sym->ts.u.cl
+ || !sym->ts.u.cl->backend_decl))))
type = gfc_character1_type_node;
else
type = gfc_typenode_for_spec (&sym->ts);
new file mode 100644
@@ -0,0 +1,46 @@
+! { dg-do run }
+! Test for allocatable scalar components and deferred length char arrays.
+! Check that fix for pr61275 works.
+! Contributed by Antony Lewis <antony@cosmologist.info> and
+! Andre Vehreschild <vehre@gmx.de>
+!
+module typeA
+ Type A
+ integer :: X
+ integer, allocatable :: y
+ character(len=:), allocatable :: c
+ end type A
+end module
+
+program test_allocatable_components
+ use typeA
+ Type(A) :: Me
+ Type(A) :: Ea
+
+ Me= A(X= 1, Y= 2, C="correctly allocated")
+
+ if (Me%X /= 1) call abort()
+ if (.not. allocated(Me%y) .or. Me%y /= 2) call abort()
+ if (.not. allocated(Me%c)) call abort()
+ if (len(Me%c) /= 19) call abort()
+ if (Me%c /= "correctly allocated") call abort()
+
+ ! Now check explicitly allocated components.
+ Ea%X = 9
+ allocate(Ea%y)
+ Ea%y = 42
+ ! Implicit allocate on assign in the next line
+ Ea%c = "13 characters"
+
+ if (Ea%X /= 9) call abort()
+ if (.not. allocated(Ea%y) .or. Ea%y /= 42) call abort()
+ if (.not. allocated(Ea%c)) call abort()
+ if (len(Ea%c) /= 13) call abort()
+ if (Ea%c /= "13 characters") call abort()
+
+ deallocate(Ea%y)
+ deallocate(Ea%c)
+ if (allocated(Ea%y)) call abort()
+ if (allocated(Ea%c)) call abort()
+end program
+