* Re: [Patch, fortran] PR68241 - [meta-bug] Deferred-length character
@ 2016-03-07 10:22 Paul Richard Thomas
2016-03-09 17:34 ` Dominique d'Humières
0 siblings, 1 reply; 4+ messages in thread
From: Paul Richard Thomas @ 2016-03-07 10:22 UTC (permalink / raw)
To: fortran, gcc-patches, Andre Vehreschild, Dominique Dhumieres
[-- Attachment #1: Type: text/plain, Size: 4180 bytes --]
Dear All,
I had promised to get the 5-branch up to date in respect of deferred
character patches after then had been in place on trunk for "a few
weeks". Well, I got pulled away by PR69423 and have only now come back
to the earlier patch.
The attached patch corresponds to trunk revisions 232450 and 233589.
They did not apply cleanly 5-branch in one or two places but it was no
big deal to put them right.
Bootstrapped and regtested on FC21/x86_64 - OK for 5-branch?
Best regards
Paul
2016-03-07 Paul Thomas <pault@gcc.gnu.org>
Backport from trunk.
PR fortran/69423
* trans-decl.c (create_function_arglist): Deferred character
length functions, with and without declared results, address
the passed reference type as '.result' and the local string
length as '..result'.
(gfc_null_and_pass_deferred_len): Helper function to null and
return deferred string lengths, as needed.
(gfc_trans_deferred_vars): Call it, thereby reducing repeated
code, add call for deferred arrays and reroute pointer function
results. Avoid using 'tmp' for anything other that a temporary
tree by introducing 'type_of_array' for the arrayspec type.
2016-03-07 Paul Thomas <pault@gcc.gnu.org>
Backport from trunk.
PR fortran/64324
* resolve.c (check_uop_procedure): Prevent deferred length
characters from being trapped by assumed length error.
Backport from trunk.
PR fortran/49630
PR fortran/54070
PR fortran/60593
PR fortran/60795
PR fortran/61147
PR fortran/64324
* trans-array.c (gfc_conv_scalarized_array_ref): Pass decl for
function as well as variable expressions.
(gfc_array_init_size): Add 'expr' as an argument. Use this to
correctly set the descriptor dtype for deferred characters.
(gfc_array_allocate): Add 'expr' to the call to
'gfc_array_init_size'.
* trans.c (gfc_build_array_ref): Expand logic for setting span
to include indirect references to character lengths.
* trans-decl.c (gfc_get_symbol_decl): Ensure that deferred
result char lengths that are PARM_DECLs are indirectly
referenced both for directly passed and by reference.
(create_function_arglist): If the length type is a pointer type
then store the length as the 'passed_length' and make the char
length an indirect reference to it.
(gfc_trans_deferred_vars): If a character length has escaped
being set as an indirect reference, return it via the 'passed
length'.
* trans-expr.c (gfc_conv_procedure_call): The length of
deferred character length results is set TREE_STATIC and set to
zero.
(gfc_trans_assignment_1): Do not fix the rse string_length if
it is a variable, a parameter or an indirect reference. Add the
code to trap assignment of scalars to unallocated arrays.
* trans-stmt.c (gfc_trans_allocate): Remove 'def_str_len' and
all references to it. Instead, replicate the code to obtain a
explicitly defined string length and provide a value before
array allocation so that the dtype is correctly set.
trans-types.c (gfc_get_character_type): If the character length
is a pointer, use the indirect reference.
2016-03-07 Paul Thomas <pault@gcc.gnu.org>
Backport from trunk.
PR fortran/69423
* gfortran.dg/deferred_character_15.f90 : New test.
2016-03-07 Paul Thomas <pault@gcc.gnu.org>
Backport from trunk.
PR fortran/49630
* gfortran.dg/deferred_character_13.f90: New test for the fix
of comment 3 of the PR.
Backport from trunk.
PR fortran/54070
* gfortran.dg/deferred_character_8.f90: New test
* gfortran.dg/allocate_error_5.f90: New test
Backport from trunk.
PR fortran/60593
* gfortran.dg/deferred_character_10.f90: New test
Backport from trunk.
PR fortran/60795
* gfortran.dg/deferred_character_14.f90: New test
Backport from trunk.
PR fortran/61147
* gfortran.dg/deferred_character_11.f90: New test
Backport from trunk.
PR fortran/64324
* gfortran.dg/deferred_character_9.f90: New test
--
The difference between genius and stupidity is; genius has its limits.
Albert Einstein
[-- Attachment #2: check02.diff --]
[-- Type: text/plain, Size: 37562 bytes --]
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 232481)
--- gcc/fortran/resolve.c (working copy)
*************** check_uop_procedure (gfc_symbol *sym, lo
*** 14904,14912 ****
}
if (sym->ts.type == BT_CHARACTER
! && !(sym->ts.u.cl && sym->ts.u.cl->length)
! && !(sym->result && sym->result->ts.u.cl
! && sym->result->ts.u.cl->length))
{
gfc_error ("User operator procedure %qs at %L cannot be assumed "
"character length", sym->name, &where);
--- 14904,14912 ----
}
if (sym->ts.type == BT_CHARACTER
! && !((sym->ts.u.cl && sym->ts.u.cl->length) || sym->ts.deferred)
! && !(sym->result && ((sym->result->ts.u.cl
! && sym->result->ts.u.cl->length) || sym->result->ts.deferred)))
{
gfc_error ("User operator procedure %qs at %L cannot be assumed "
"character length", sym->name, &where);
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 232482)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3113,3119 ****
index, info->offset);
if (expr && (is_subref_array (expr)
! || (expr->ts.deferred && expr->expr_type == EXPR_VARIABLE)))
decl = expr->symtree->n.sym->backend_decl;
tmp = build_fold_indirect_ref_loc (input_location, info->data);
--- 3113,3120 ----
index, info->offset);
if (expr && (is_subref_array (expr)
! || (expr->ts.deferred && (expr->expr_type == EXPR_VARIABLE
! || expr->expr_type == EXPR_FUNCTION))))
decl = expr->symtree->n.sym->backend_decl;
tmp = build_fold_indirect_ref_loc (input_location, info->data);
*************** static tree
*** 4957,4963 ****
gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
stmtblock_t * descriptor_block, tree * overflow,
! tree expr3_elem_size, tree *nelems, gfc_expr *expr3)
{
tree type;
tree tmp;
--- 4958,4965 ----
gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
gfc_expr ** lower, gfc_expr ** upper, stmtblock_t * pblock,
stmtblock_t * descriptor_block, tree * overflow,
! tree expr3_elem_size, tree *nelems, gfc_expr *expr3,
! gfc_expr *expr)
{
tree type;
tree tmp;
*************** gfc_array_init_size (tree descriptor, in
*** 4982,4989 ****
--- 4984,5002 ----
offset = gfc_index_zero_node;
/* Set the dtype. */
+ if (expr->ts.type == BT_CHARACTER && expr->ts.deferred
+ && TREE_CODE (expr->ts.u.cl->backend_decl) == VAR_DECL)
+ {
+ type = gfc_typenode_for_spec (&expr->ts);
+ tmp = gfc_conv_descriptor_dtype (descriptor);
+ gfc_add_modify (descriptor_block, tmp,
+ gfc_get_dtype_rank_type (rank, type));
+ }
+ else
+ {
tmp = gfc_conv_descriptor_dtype (descriptor);
gfc_add_modify (descriptor_block, tmp, gfc_get_dtype (type));
+ }
or_expr = boolean_false_node;
*************** gfc_array_allocate (gfc_se * se, gfc_exp
*** 5295,5301 ****
size = gfc_array_init_size (se->expr, ref->u.ar.as->rank,
ref->u.ar.as->corank, &offset, lower, upper,
&se->pre, &set_descriptor_block, &overflow,
! expr3_elem_size, nelems, expr3);
if (dimension)
{
--- 5308,5314 ----
size = gfc_array_init_size (se->expr, ref->u.ar.as->rank,
ref->u.ar.as->corank, &offset, lower, upper,
&se->pre, &set_descriptor_block, &overflow,
! expr3_elem_size, nelems, expr3, expr);
if (dimension)
{
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c (revision 232481)
--- gcc/fortran/trans-decl.c (working copy)
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1340,1347 ****
&& TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL)
{
sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
! sym->ts.u.cl->backend_decl = NULL_TREE;
! length = gfc_create_string_length (sym);
}
fun_or_res = byref && (sym->attr.result
--- 1340,1347 ----
&& TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL)
{
sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
! gcc_assert (POINTER_TYPE_P (TREE_TYPE (sym->ts.u.cl->passed_length)));
! sym->ts.u.cl->backend_decl = build_fold_indirect_ref (sym->ts.u.cl->backend_decl);
}
fun_or_res = byref && (sym->attr.result
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1383,1391 ****
--- 1383,1394 ----
/* We need to insert a indirect ref for param decls. */
if (sym->ts.u.cl->backend_decl
&& TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL)
+ {
+ sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
sym->ts.u.cl->backend_decl =
build_fold_indirect_ref (sym->ts.u.cl->backend_decl);
}
+ }
/* For all other parameters make sure, that they are copied so
that the value and any modifications are local to the routine
by generating a temporary variable. */
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1394,1399 ****
--- 1397,1406 ----
&& sym->ts.u.cl->backend_decl)
{
sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
+ if (POINTER_TYPE_P (TREE_TYPE (sym->ts.u.cl->passed_length)))
+ sym->ts.u.cl->backend_decl
+ = build_fold_indirect_ref (sym->ts.u.cl->backend_decl);
+ else
sym->ts.u.cl->backend_decl = NULL_TREE;
}
}
*************** create_function_arglist (gfc_symbol * sy
*** 2170,2176 ****
PARM_DECL,
get_identifier (".__result"),
len_type);
! if (!sym->ts.u.cl->length)
{
sym->ts.u.cl->backend_decl = length;
TREE_USED (length) = 1;
--- 2177,2188 ----
PARM_DECL,
get_identifier (".__result"),
len_type);
! if (POINTER_TYPE_P (len_type))
! {
! sym->ts.u.cl->passed_length = length;
! TREE_USED (length) = 1;
! }
! else if (!sym->ts.u.cl->length)
{
sym->ts.u.cl->backend_decl = length;
TREE_USED (length) = 1;
*************** create_function_arglist (gfc_symbol * sy
*** 2290,2296 ****
if (f->sym->ts.u.cl->backend_decl == NULL
|| f->sym->ts.u.cl->backend_decl == length)
{
! if (f->sym->ts.u.cl->backend_decl == NULL)
gfc_create_string_length (f->sym);
/* Make sure PARM_DECL type doesn't point to incomplete type. */
--- 2302,2311 ----
if (f->sym->ts.u.cl->backend_decl == NULL
|| f->sym->ts.u.cl->backend_decl == length)
{
! if (POINTER_TYPE_P (len_type))
! f->sym->ts.u.cl->backend_decl =
! build_fold_indirect_ref_loc (input_location, length);
! else if (f->sym->ts.u.cl->backend_decl == NULL)
gfc_create_string_length (f->sym);
/* Make sure PARM_DECL type doesn't point to incomplete type. */
*************** init_intent_out_dt (gfc_symbol * proc_sy
*** 3828,3833 ****
--- 3843,3904 ----
}
+ /* Helper function to manage deferred string lengths. */
+
+ static tree
+ gfc_null_and_pass_deferred_len (gfc_symbol *sym, stmtblock_t *init,
+ locus *loc)
+ {
+ tree tmp;
+
+ /* Character length passed by reference. */
+ tmp = sym->ts.u.cl->passed_length;
+ tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ tmp = fold_convert (gfc_charlen_type_node, tmp);
+
+ if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
+ /* Zero the string length when entering the scope. */
+ gfc_add_modify (init, sym->ts.u.cl->backend_decl,
+ build_int_cst (gfc_charlen_type_node, 0));
+ else
+ {
+ tree tmp2;
+
+ tmp2 = fold_build2_loc (input_location, MODIFY_EXPR,
+ gfc_charlen_type_node,
+ sym->ts.u.cl->backend_decl, tmp);
+ if (sym->attr.optional)
+ {
+ tree present = gfc_conv_expr_present (sym);
+ tmp2 = build3_loc (input_location, COND_EXPR,
+ void_type_node, present, tmp2,
+ build_empty_stmt (input_location));
+ }
+ gfc_add_expr_to_block (init, tmp2);
+ }
+
+ gfc_restore_backend_locus (loc);
+
+ /* Pass the final character length back. */
+ if (sym->attr.intent != INTENT_IN)
+ {
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+ gfc_charlen_type_node, tmp,
+ sym->ts.u.cl->backend_decl);
+ if (sym->attr.optional)
+ {
+ tree present = gfc_conv_expr_present (sym);
+ tmp = build3_loc (input_location, COND_EXPR,
+ void_type_node, present, tmp,
+ build_empty_stmt (input_location));
+ }
+ }
+ else
+ tmp = NULL_TREE;
+
+ return tmp;
+ }
+
/* Generate function entry and exit code, and add it to the function body.
This includes:
Allocation and initialization of array variables.
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 3877,3884 ****
--- 3948,3967 ----
/* An automatic character length, pointer array result. */
if (proc_sym->ts.type == BT_CHARACTER
&& TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
+ {
+ tmp = NULL;
+ if (proc_sym->ts.deferred)
+ {
+ gfc_save_backend_locus (&loc);
+ gfc_set_backend_locus (&proc_sym->declared_at);
+ gfc_start_block (&init);
+ tmp = gfc_null_and_pass_deferred_len (proc_sym, &init, &loc);
+ gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
+ }
+ else
gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block);
}
+ }
else if (proc_sym->ts.type == BT_CHARACTER)
{
if (proc_sym->ts.deferred)
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 3903,3914 ****
--- 3986,4005 ----
gfc_restore_backend_locus (&loc);
/* Pass back the string length on exit. */
+ tmp = proc_sym->ts.u.cl->backend_decl;
+ if (TREE_CODE (tmp) != INDIRECT_REF
+ && proc_sym->ts.u.cl->passed_length)
+ {
tmp = proc_sym->ts.u.cl->passed_length;
tmp = build_fold_indirect_ref_loc (input_location, tmp);
tmp = fold_convert (gfc_charlen_type_node, tmp);
tmp = fold_build2_loc (input_location, MODIFY_EXPR,
gfc_charlen_type_node, tmp,
proc_sym->ts.u.cl->backend_decl);
+ }
+ else
+ tmp = NULL_TREE;
+
gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
}
else if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 3979,3988 ****
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)
{
case AS_EXPLICIT:
if (sym->attr.dummy || sym->attr.result)
--- 4070,4079 ----
else if (sym->attr.dimension || sym->attr.codimension)
{
/* Assumed-size Cray pointees need to be treated as AS_EXPLICIT. */
! array_type type_of_array = sym->as->type;
! if (type_of_array == AS_ASSUMED_SIZE && sym->as->cp_was_assumed)
! type_of_array = AS_EXPLICIT;
! switch (type_of_array)
{
case AS_EXPLICIT:
if (sym->attr.dummy || sym->attr.result)
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4059,4064 ****
--- 4150,4164 ----
case AS_DEFERRED:
seen_trans_deferred_array = true;
gfc_trans_deferred_array (sym, block);
+ if (sym->ts.type == BT_CHARACTER && sym->ts.deferred
+ && sym->attr.result)
+ {
+ gfc_start_block (&init);
+ gfc_save_backend_locus (&loc);
+ gfc_set_backend_locus (&sym->declared_at);
+ tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc);
+ gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
+ }
break;
default:
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4073,4078 ****
--- 4173,4179 ----
continue;
else if ((!sym->attr.dummy || sym->ts.deferred)
&& (sym->attr.allocatable
+ || (sym->attr.pointer && sym->attr.result)
|| (sym->ts.type == BT_CLASS
&& CLASS_DATA (sym)->attr.allocatable)))
{
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4080,4085 ****
--- 4181,4192 ----
{
tree descriptor = NULL_TREE;
+ gfc_save_backend_locus (&loc);
+ gfc_set_backend_locus (&sym->declared_at);
+ gfc_start_block (&init);
+
+ if (!sym->attr.pointer)
+ {
/* Nullify and automatic deallocation of allocatable
scalars. */
e = gfc_lval_expr_from_sym (sym);
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4103,4108 ****
--- 4210,4216 ----
}
else
{
+ se.descriptor_only = 1;
gfc_conv_expr (&se, e);
descriptor = se.expr;
se.expr = gfc_conv_descriptor_data_addr (se.expr);
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4110,4119 ****
}
gfc_free_expr (e);
- gfc_save_backend_locus (&loc);
- gfc_set_backend_locus (&sym->declared_at);
- gfc_start_block (&init);
-
if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
{
/* Nullify when entering the scope. */
--- 4218,4223 ----
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4130,4191 ****
}
gfc_add_expr_to_block (&init, tmp);
}
if ((sym->attr.dummy || sym->attr.result)
&& sym->ts.type == BT_CHARACTER
! && sym->ts.deferred)
! {
! /* Character length passed by reference. */
! tmp = sym->ts.u.cl->passed_length;
! tmp = build_fold_indirect_ref_loc (input_location, tmp);
! tmp = fold_convert (gfc_charlen_type_node, tmp);
!
! if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
! /* Zero the string length when entering the scope. */
! gfc_add_modify (&init, sym->ts.u.cl->backend_decl,
! build_int_cst (gfc_charlen_type_node, 0));
! else
! {
! tree tmp2;
!
! tmp2 = fold_build2_loc (input_location, MODIFY_EXPR,
! gfc_charlen_type_node,
! sym->ts.u.cl->backend_decl, tmp);
! if (sym->attr.optional)
! {
! tree present = gfc_conv_expr_present (sym);
! tmp2 = build3_loc (input_location, COND_EXPR,
! void_type_node, present, tmp2,
! build_empty_stmt (input_location));
! }
! gfc_add_expr_to_block (&init, tmp2);
! }
!
! gfc_restore_backend_locus (&loc);
!
! /* Pass the final character length back. */
! if (sym->attr.intent != INTENT_IN)
! {
! tmp = fold_build2_loc (input_location, MODIFY_EXPR,
! gfc_charlen_type_node, tmp,
! sym->ts.u.cl->backend_decl);
! if (sym->attr.optional)
! {
! tree present = gfc_conv_expr_present (sym);
! tmp = build3_loc (input_location, COND_EXPR,
! void_type_node, present, tmp,
! build_empty_stmt (input_location));
! }
! }
! else
! tmp = NULL_TREE;
! }
else
gfc_restore_backend_locus (&loc);
/* Deallocate when leaving the scope. Nullifying is not
needed. */
! if (!sym->attr.result && !sym->attr.dummy
&& !sym->ns->proc_name->attr.is_main_program)
{
if (sym->ts.type == BT_CLASS
--- 4234,4252 ----
}
gfc_add_expr_to_block (&init, tmp);
}
+ }
if ((sym->attr.dummy || sym->attr.result)
&& sym->ts.type == BT_CHARACTER
! && sym->ts.deferred
! && sym->ts.u.cl->passed_length)
! tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc);
else
gfc_restore_backend_locus (&loc);
/* Deallocate when leaving the scope. Nullifying is not
needed. */
! if (!sym->attr.result && !sym->attr.dummy && !sym->attr.pointer
&& !sym->ns->proc_name->attr.is_main_program)
{
if (sym->ts.type == BT_CLASS
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4202,4207 ****
--- 4263,4269 ----
gfc_free_expr (expr);
}
}
+
if (sym->ts.type == BT_CLASS)
{
/* Initialize _vptr to declared type. */
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 4242,4260 ****
if (sym->attr.dummy)
{
gfc_start_block (&init);
!
! /* Character length passed by reference. */
! tmp = sym->ts.u.cl->passed_length;
! tmp = build_fold_indirect_ref_loc (input_location, tmp);
! tmp = fold_convert (gfc_charlen_type_node, tmp);
! gfc_add_modify (&init, sym->ts.u.cl->backend_decl, tmp);
! /* Pass the final character length back. */
! if (sym->attr.intent != INTENT_IN)
! tmp = fold_build2_loc (input_location, MODIFY_EXPR,
! gfc_charlen_type_node, tmp,
! sym->ts.u.cl->backend_decl);
! else
! tmp = NULL_TREE;
gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
}
}
--- 4304,4312 ----
if (sym->attr.dummy)
{
gfc_start_block (&init);
! gfc_save_backend_locus (&loc);
! gfc_set_backend_locus (&sym->declared_at);
! tmp = gfc_null_and_pass_deferred_len (sym, &init, &loc);
gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
}
}
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 232482)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5752,5757 ****
--- 5752,5760 ----
tmp = len;
if (TREE_CODE (tmp) != VAR_DECL)
tmp = gfc_evaluate_now (len, &se->pre);
+ TREE_STATIC (tmp) = 1;
+ gfc_add_modify (&se->pre, tmp,
+ build_int_cst (TREE_TYPE (tmp), 0));
tmp = gfc_build_addr_expr (NULL_TREE, tmp);
vec_safe_push (retargs, tmp);
}
*************** gfc_trans_assignment_1 (gfc_expr * expr1
*** 9052,9058 ****
}
/* Stabilize a string length for temporaries. */
! if (expr2->ts.type == BT_CHARACTER && !expr2->ts.deferred)
string_length = gfc_evaluate_now (rse.string_length, &rse.pre);
else if (expr2->ts.type == BT_CHARACTER)
string_length = rse.string_length;
--- 9055,9064 ----
}
/* Stabilize a string length for temporaries. */
! if (expr2->ts.type == BT_CHARACTER && !expr1->ts.deferred
! && !(TREE_CODE (rse.string_length) == VAR_DECL
! || TREE_CODE (rse.string_length) == PARM_DECL
! || TREE_CODE (rse.string_length) == INDIRECT_REF))
string_length = gfc_evaluate_now (rse.string_length, &rse.pre);
else if (expr2->ts.type == BT_CHARACTER)
string_length = rse.string_length;
*************** gfc_trans_assignment_1 (gfc_expr * expr1
*** 9066,9072 ****
--- 9072,9103 ----
lse.string_length = string_length;
}
else
+ {
gfc_conv_expr (&lse, expr1);
+ if (gfc_option.rtcheck & GFC_RTCHECK_MEM
+ && gfc_expr_attr (expr1).allocatable
+ && expr1->rank
+ && !expr2->rank)
+ {
+ tree cond;
+ const char* msg;
+
+ tmp = expr1->symtree->n.sym->backend_decl;
+ if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+ tmp = build_fold_indirect_ref_loc (input_location, tmp);
+
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ tmp = gfc_conv_descriptor_data_get (tmp);
+ else
+ tmp = TREE_OPERAND (lse.expr, 0);
+
+ cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+ tmp, build_int_cst (TREE_TYPE (tmp), 0));
+ msg = _("Assignment of scalar to unallocated array");
+ gfc_trans_runtime_check (true, false, cond, &loop.pre,
+ &expr1->where, msg);
+ }
+ }
/* Assignments of scalar derived types with allocatable components
to arrays must be done with a deep copy and the rhs temporary
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c (revision 232481)
--- gcc/fortran/trans-stmt.c (working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 5119,5125 ****
tree label_finish;
tree memsz;
tree al_vptr, al_len;
! tree def_str_len = NULL_TREE;
/* If an expr3 is present, then store the tree for accessing its
_vptr, and _len components in the variables, respectively. The
element size, i.e. _vptr%size, is stored in expr3_esize. Any of
--- 5119,5125 ----
tree label_finish;
tree memsz;
tree al_vptr, al_len;
!
/* If an expr3 is present, then store the tree for accessing its
_vptr, and _len components in the variables, respectively. The
element size, i.e. _vptr%size, is stored in expr3_esize. Any of
*************** gfc_trans_allocate (gfc_code * code)
*** 5382,5388 ****
expr3_esize = fold_build2_loc (input_location, MULT_EXPR,
TREE_TYPE (se_sz.expr),
tmp, se_sz.expr);
- def_str_len = gfc_evaluate_now (se_sz.expr, &block);
}
}
--- 5382,5387 ----
*************** gfc_trans_allocate (gfc_code * code)
*** 5435,5450 ****
se.want_pointer = 1;
se.descriptor_only = 1;
- if (expr->ts.type == BT_CHARACTER
- && expr->ts.deferred
- && TREE_CODE (expr->ts.u.cl->backend_decl) == VAR_DECL
- && def_str_len != NULL_TREE)
- {
- tmp = expr->ts.u.cl->backend_decl;
- gfc_add_modify (&block, tmp,
- fold_convert (TREE_TYPE (tmp), def_str_len));
- }
-
gfc_conv_expr (&se, expr);
if (expr->ts.type == BT_CHARACTER && expr->ts.deferred)
/* se.string_length now stores the .string_length variable of expr
--- 5434,5439 ----
*************** gfc_trans_allocate (gfc_code * code)
*** 5578,5583 ****
--- 5567,5586 ----
/* Prevent setting the length twice. */
al_len_needs_set = false;
}
+ else if (expr->ts.type == BT_CHARACTER && al_len != NULL_TREE
+ && code->ext.alloc.ts.u.cl->length)
+ {
+ /* Cover the cases where a string length is explicitly
+ specified by a type spec for deferred length character
+ arrays or unlimited polymorphic objects without a
+ source= or mold= expression. */
+ gfc_init_se (&se_sz, NULL);
+ gfc_conv_expr (&se_sz, code->ext.alloc.ts.u.cl->length);
+ gfc_add_modify (&block, al_len,
+ fold_convert (TREE_TYPE (al_len),
+ se_sz.expr));
+ al_len_needs_set = false;
+ }
}
gfc_add_block_to_block (&block, &se.pre);
Index: gcc/fortran/trans-types.c
===================================================================
*** gcc/fortran/trans-types.c (revision 232481)
--- gcc/fortran/trans-types.c (working copy)
*************** gfc_get_character_type (int kind, gfc_ch
*** 1067,1072 ****
--- 1067,1074 ----
tree len;
len = (cl == NULL) ? NULL_TREE : cl->backend_decl;
+ if (len && POINTER_TYPE_P (TREE_TYPE (len)))
+ len = build_fold_indirect_ref (len);
return gfc_get_character_type_len (kind, len);
}
Index: gcc/fortran/trans.c
===================================================================
*** gcc/fortran/trans.c (revision 232481)
--- gcc/fortran/trans.c (working copy)
*************** gfc_build_array_ref (tree base, tree off
*** 348,357 ****
references. */
if (type && TREE_CODE (type) == ARRAY_TYPE
&& TYPE_MAXVAL (TYPE_DOMAIN (type)) != NULL_TREE
! && TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == VAR_DECL
&& decl
! && DECL_CONTEXT (TYPE_MAXVAL (TYPE_DOMAIN (type)))
! == DECL_CONTEXT (decl))
span = TYPE_MAXVAL (TYPE_DOMAIN (type));
else
span = NULL_TREE;
--- 348,360 ----
references. */
if (type && TREE_CODE (type) == ARRAY_TYPE
&& TYPE_MAXVAL (TYPE_DOMAIN (type)) != NULL_TREE
! && (TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == VAR_DECL
! || TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == INDIRECT_REF)
&& decl
! && (TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == INDIRECT_REF
! || TREE_CODE (decl) == FUNCTION_DECL
! || DECL_CONTEXT (TYPE_MAXVAL (TYPE_DOMAIN (type)))
! == DECL_CONTEXT (decl)))
span = TYPE_MAXVAL (TYPE_DOMAIN (type));
else
span = NULL_TREE;
*************** gfc_build_array_ref (tree base, tree off
*** 367,373 ****
and reference the element with pointer arithmetic. */
if (decl && (TREE_CODE (decl) == FIELD_DECL
|| TREE_CODE (decl) == VAR_DECL
! || TREE_CODE (decl) == PARM_DECL)
&& ((GFC_DECL_SUBREF_ARRAY_P (decl)
&& !integer_zerop (GFC_DECL_SPAN(decl)))
|| GFC_DECL_CLASS (decl)
--- 370,377 ----
and reference the element with pointer arithmetic. */
if (decl && (TREE_CODE (decl) == FIELD_DECL
|| TREE_CODE (decl) == VAR_DECL
! || TREE_CODE (decl) == PARM_DECL
! || TREE_CODE (decl) == FUNCTION_DECL)
&& ((GFC_DECL_SUBREF_ARRAY_P (decl)
&& !integer_zerop (GFC_DECL_SPAN(decl)))
|| GFC_DECL_CLASS (decl)
Index: gcc/testsuite/gfortran.dg/allocate_error_5.f90
===================================================================
*** gcc/testsuite/gfortran.dg/allocate_error_5.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/allocate_error_5.f90 (working copy)
***************
*** 0 ****
--- 1,23 ----
+ ! { dg-do run }
+ ! { dg-additional-options "-fcheck=mem" }
+ ! { dg-shouldfail "Fortran runtime error: Assignment of scalar to unallocated array" }
+ !
+ ! This omission was encountered in the course of fixing PR54070. Whilst this is a
+ ! very specific case, others such as allocatable components have been tested.
+ !
+ ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+ !
+ function g(a) result (res)
+ character(len=*) :: a
+ character(len=:),allocatable :: res(:)
+ res = a ! Since 'res' is not allocated, a runtime error should occur.
+ end function
+
+ interface
+ function g(a) result(res)
+ character(len=*) :: a
+ character(len=:),allocatable :: res(:)
+ end function
+ end interface
+ print *, g("ABC")
+ end
Index: gcc/testsuite/gfortran.dg/deferred_character_10.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_10.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/deferred_character_10.f90 (working copy)
***************
*** 0 ****
--- 1,52 ----
+ ! { dg-do run }
+ !
+ ! Checks that PR60593 is fixed (Revision: 214757)
+ !
+ ! Contributed by Steve Kargl <kargl@gcc.gnu.org>
+ !
+ ! Main program added for this test.
+ !
+ module stringhelper_m
+
+ implicit none
+
+ type :: string_t
+ character(:), allocatable :: string
+ end type
+
+ interface len
+ function strlen(s) bind(c,name='strlen')
+ use iso_c_binding
+ implicit none
+ type(c_ptr), intent(in), value :: s
+ integer(c_size_t) :: strlen
+ end function
+ end interface
+
+ contains
+
+ function C2FChar(c_charptr) result(res)
+ use iso_c_binding
+ type(c_ptr), intent(in) :: c_charptr
+ character(:), allocatable :: res
+ character(kind=c_char,len=1), pointer :: string_p(:)
+ integer i, c_str_len
+ c_str_len = int(len(c_charptr))
+ call c_f_pointer(c_charptr, string_p, [c_str_len])
+ allocate(character(c_str_len) :: res)
+ forall (i = 1:c_str_len) res(i:i) = string_p(i)
+ end function
+
+ end module
+
+ use stringhelper_m
+ use iso_c_binding
+ implicit none
+ type(c_ptr) :: cptr
+ character(20), target :: str
+
+ str = "abcdefghij"//char(0)
+ cptr = c_loc (str)
+ if (len (C2FChar (cptr)) .ne. 10) call abort
+ if (C2FChar (cptr) .ne. "abcdefghij") call abort
+ end
Index: gcc/testsuite/gfortran.dg/deferred_character_11.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_11.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/deferred_character_11.f90 (working copy)
***************
*** 0 ****
--- 1,39 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR61147.
+ !
+ ! Contributed by Thomas Clune <Thomas.L.Clune@nasa.gov>
+ !
+ module B_mod
+
+ type :: B
+ character(:), allocatable :: string
+ end type B
+
+ contains
+
+ function toPointer(this) result(ptr)
+ character(:), pointer :: ptr
+ class (B), intent(in), target :: this
+
+ ptr => this%string
+
+ end function toPointer
+
+ end module B_mod
+
+ program main
+ use B_mod
+
+ type (B) :: obj
+ character(:), pointer :: p
+
+ obj%string = 'foo'
+ p => toPointer(obj)
+
+ If (len (p) .ne. 3) call abort
+ If (p .ne. "foo") call abort
+
+ end program main
+
+
Index: gcc/testsuite/gfortran.dg/deferred_character_12.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_12.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/deferred_character_12.f90 (working copy)
***************
*** 0 ****
--- 1,37 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR63232
+ !
+ ! Contributed by Balint Aradi <baradi09@gmail.com>
+ !
+ module mymod
+ implicit none
+
+ type :: wrapper
+ character(:), allocatable :: string
+ end type wrapper
+
+ contains
+
+
+ subroutine sub2(mystring)
+ character(:), allocatable, intent(out) :: mystring
+
+ mystring = "test"
+
+ end subroutine sub2
+
+ end module mymod
+
+
+ program test
+ use mymod
+ implicit none
+
+ type(wrapper) :: mywrapper
+
+ call sub2(mywrapper%string)
+ if (.not. allocated(mywrapper%string)) call abort
+ if (trim(mywrapper%string) .ne. "test") call abort
+
+ end program test
Index: gcc/testsuite/gfortran.dg/deferred_character_13.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_13.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/deferred_character_13.f90 (working copy)
***************
*** 0 ****
--- 1,34 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR49630 comment #3.
+ !
+ ! Contributed by Janus Weil <janus@gcc.gnu.org>
+ !
+ module abc
+ implicit none
+
+ type::abc_type
+ contains
+ procedure::abc_function
+ end type abc_type
+
+ contains
+
+ function abc_function(this)
+ class(abc_type),intent(in)::this
+ character(:),allocatable::abc_function
+ allocate(abc_function,source="hello")
+ end function abc_function
+
+ subroutine do_something(this)
+ class(abc_type),intent(in)::this
+ if (this%abc_function() .ne. "hello") call abort
+ end subroutine do_something
+
+ end module abc
+
+
+ use abc
+ type(abc_type) :: a
+ call do_something(a)
+ end
Index: gcc/testsuite/gfortran.dg/deferred_character_14.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_14.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/deferred_character_14.f90 (working copy)
***************
*** 0 ****
--- 1,30 ----
+ ! { dg-do run }
+ !
+ ! Test fix for PR60795 comments #1 and #4
+ !
+ ! Contributed by Kergonath <kergonath@me.com>
+ !
+ module m
+ contains
+ subroutine allocate_array(s_array)
+ character(:), dimension(:), allocatable, intent(out) :: s_array
+
+ allocate(character(2) :: s_array(2))
+ s_array = ["ab","cd"]
+ end subroutine
+ end module
+
+ program stringtest
+ use m
+ character(:), dimension(:), allocatable :: s4
+ character(:), dimension(:), allocatable :: s
+ ! Comment #1
+ allocate(character(1) :: s(10))
+ if (size (s) .ne. 10) call abort
+ if (len (s) .ne. 1) call abort
+ ! Comment #4
+ call allocate_array(s4)
+ if (size (s4) .ne. 2) call abort
+ if (len (s4) .ne. 2) call abort
+ if (any (s4 .ne. ["ab", "cd"])) call abort
+ end program
Index: gcc/testsuite/gfortran.dg/deferred_character_15.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_15.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/deferred_character_15.f90 (working copy)
***************
*** 0 ****
--- 1,44 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR69423.
+ !
+ ! Contributed by Antony Lewis <antony@cosmologist.info>
+ !
+ program tester
+ character(LEN=:), allocatable :: S
+ S= test(2)
+ if (len(S) .ne. 4) call abort
+ if (S .ne. "test") call abort
+ if (allocated (S)) deallocate (S)
+
+ S= test2(2)
+ if (len(S) .ne. 4) call abort
+ if (S .ne. "test") call abort
+ if (allocated (S)) deallocate (S)
+ contains
+ function test(alen)
+ character(LEN=:), allocatable :: test
+ integer alen, i
+ do i = alen, 1, -1
+ test = 'test'
+ exit
+ end do
+ ! This line would print nothing when compiled with -O1 and higher.
+ ! print *, len(test),test
+ if (len(test) .ne. 4) call abort
+ if (test .ne. "test") call abort
+ end function test
+
+ function test2(alen) result (test)
+ character(LEN=:), allocatable :: test
+ integer alen, i
+ do i = alen, 1, -1
+ test = 'test'
+ exit
+ end do
+ ! This worked before the fix.
+ ! print *, len(test),test
+ if (len(test) .ne. 4) call abort
+ if (test .ne. "test") call abort
+ end function test2
+ end program tester
Index: gcc/testsuite/gfortran.dg/deferred_character_8.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_8.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/deferred_character_8.f90 (working copy)
***************
*** 0 ****
--- 1,84 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for all the remaining issues in PR54070. These were all
+ ! concerned with deferred length characters being returned as function results,
+ ! except for comment #23 where the descriptor dtype was not correctly set and
+ ! array IO failed in consequence.
+ !
+ ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+ !
+ ! The original comment #1 with an allocate statement.
+ ! Allocatable, deferred length scalar resul.
+ function f()
+ character(len=:),allocatable :: f
+ allocate (f, source = "abc")
+ f ="ABC"
+ end function
+ !
+ ! Allocatable, deferred length, explicit, array result
+ function g(a) result (res)
+ character(len=*) :: a(:)
+ character(len (a)) :: b(size (a))
+ character(len=:),allocatable :: res(:)
+ integer :: i
+ allocate (character(len(a)) :: res(2*size(a)))
+ do i = 1, len (a)
+ b(:)(i:i) = char (ichar (a(:)(i:i)) + 4)
+ end do
+ res = [a, b]
+ end function
+ !
+ ! Allocatable, deferred length, array result
+ function h(a)
+ character(len=*) :: a(:)
+ character(len(a)) :: b (size(a))
+ character(len=:),allocatable :: h(:)
+ integer :: i
+ allocate (character(len(a)) :: h(size(a)))
+ do i = 1, len (a)
+ b(:)(i:i) = char (ichar (a(:)(i:i)) + 32)
+ end do
+ h = b
+ end function
+
+ module deferred_length_char_array
+ contains
+ function return_string(argument)
+ character(*) :: argument
+ character(:), dimension(:), allocatable :: return_string
+ allocate (character (len(argument)) :: return_string(2))
+ return_string = argument
+ end function
+ end module
+
+ use deferred_length_char_array
+ character(len=3) :: chr(3)
+ character(:), pointer :: s(:)
+ character(6) :: buffer
+ interface
+ function f()
+ character(len=:),allocatable :: f
+ end function
+ function g(a) result(res)
+ character(len=*) :: a(:)
+ character(len=:),allocatable :: res(:)
+ end function
+ function h(a)
+ character(len=*) :: a(:)
+ character(len=:),allocatable :: h(:)
+ end function
+ end interface
+
+ if (f () .ne. "ABC") call abort
+ if (any (g (["ab","cd"]) .ne. ["ab","cd","ef","gh"])) call abort
+ chr = h (["ABC","DEF","GHI"])
+ if (any (chr .ne. ["abc","def","ghi"])) call abort
+ if (any (return_string ("abcdefg") .ne. ["abcdefg","abcdefg"])) call abort
+
+ ! Comment #23
+ allocate(character(3)::s(2))
+ s(1) = 'foo'
+ s(2) = 'bar'
+ write (buffer, '(2A3)') s
+ if (buffer .ne. 'foobar') call abort
+ end
Index: gcc/testsuite/gfortran.dg/deferred_character_9.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_9.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/deferred_character_9.f90 (working copy)
***************
*** 0 ****
--- 1,28 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR64324 in which deferred length user ops
+ ! were being mistaken as assumed length and so rejected.
+ !
+ ! Contributed by Ian Harvey <ian_harvey@bigpond.com>
+ !
+ MODULE m
+ IMPLICIT NONE
+ INTERFACE OPERATOR(.ToString.)
+ MODULE PROCEDURE tostring
+ END INTERFACE OPERATOR(.ToString.)
+ CONTAINS
+ FUNCTION tostring(arg)
+ INTEGER, INTENT(IN) :: arg
+ CHARACTER(:), ALLOCATABLE :: tostring
+ allocate (character(5) :: tostring)
+ write (tostring, "(I5)") arg
+ END FUNCTION tostring
+ END MODULE m
+
+ use m
+ character(:), allocatable :: str
+ integer :: i = 999
+ str = .ToString. i
+ if (str .ne. " 999") call abort
+ end
+
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] PR68241 - [meta-bug] Deferred-length character
2016-03-07 10:22 [Patch, fortran] PR68241 - [meta-bug] Deferred-length character Paul Richard Thomas
@ 2016-03-09 17:34 ` Dominique d'Humières
2016-03-09 18:33 ` Paul Richard Thomas
0 siblings, 1 reply; 4+ messages in thread
From: Dominique d'Humières @ 2016-03-09 17:34 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: fortran, gcc-patches, Andre Vehreschild
Dear Paul,
As you said on IRC the patch needs -l to apply. After that the gcc-5 branch bootstrapped and regtested without any problem.
Thanks,
Dominique
> Le 7 mars 2016 à 11:22, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
>
> Dear All,
>
> I had promised to get the 5-branch up to date in respect of deferred
> character patches after then had been in place on trunk for "a few
> weeks". Well, I got pulled away by PR69423 and have only now come back
> to the earlier patch.
>
> The attached patch corresponds to trunk revisions 232450 and 233589.
> They did not apply cleanly 5-branch in one or two places but it was no
> big deal to put them right.
>
> Bootstrapped and regtested on FC21/x86_64 - OK for 5-branch?
>
> Best regards
>
> Paul
>
> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>
> Backport from trunk.
> PR fortran/69423
> * trans-decl.c (create_function_arglist): Deferred character
> length functions, with and without declared results, address
> the passed reference type as '.result' and the local string
> length as '..result'.
> (gfc_null_and_pass_deferred_len): Helper function to null and
> return deferred string lengths, as needed.
> (gfc_trans_deferred_vars): Call it, thereby reducing repeated
> code, add call for deferred arrays and reroute pointer function
> results. Avoid using 'tmp' for anything other that a temporary
> tree by introducing 'type_of_array' for the arrayspec type.
>
> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>
> Backport from trunk.
> PR fortran/64324
> * resolve.c (check_uop_procedure): Prevent deferred length
> characters from being trapped by assumed length error.
>
> Backport from trunk.
> PR fortran/49630
> PR fortran/54070
> PR fortran/60593
> PR fortran/60795
> PR fortran/61147
> PR fortran/64324
> * trans-array.c (gfc_conv_scalarized_array_ref): Pass decl for
> function as well as variable expressions.
> (gfc_array_init_size): Add 'expr' as an argument. Use this to
> correctly set the descriptor dtype for deferred characters.
> (gfc_array_allocate): Add 'expr' to the call to
> 'gfc_array_init_size'.
> * trans.c (gfc_build_array_ref): Expand logic for setting span
> to include indirect references to character lengths.
> * trans-decl.c (gfc_get_symbol_decl): Ensure that deferred
> result char lengths that are PARM_DECLs are indirectly
> referenced both for directly passed and by reference.
> (create_function_arglist): If the length type is a pointer type
> then store the length as the 'passed_length' and make the char
> length an indirect reference to it.
> (gfc_trans_deferred_vars): If a character length has escaped
> being set as an indirect reference, return it via the 'passed
> length'.
> * trans-expr.c (gfc_conv_procedure_call): The length of
> deferred character length results is set TREE_STATIC and set to
> zero.
> (gfc_trans_assignment_1): Do not fix the rse string_length if
> it is a variable, a parameter or an indirect reference. Add the
> code to trap assignment of scalars to unallocated arrays.
> * trans-stmt.c (gfc_trans_allocate): Remove 'def_str_len' and
> all references to it. Instead, replicate the code to obtain a
> explicitly defined string length and provide a value before
> array allocation so that the dtype is correctly set.
> trans-types.c (gfc_get_character_type): If the character length
> is a pointer, use the indirect reference.
>
> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>
> Backport from trunk.
> PR fortran/69423
> * gfortran.dg/deferred_character_15.f90 : New test.
>
> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>
> Backport from trunk.
> PR fortran/49630
> * gfortran.dg/deferred_character_13.f90: New test for the fix
> of comment 3 of the PR.
>
> Backport from trunk.
> PR fortran/54070
> * gfortran.dg/deferred_character_8.f90: New test
> * gfortran.dg/allocate_error_5.f90: New test
>
> Backport from trunk.
> PR fortran/60593
> * gfortran.dg/deferred_character_10.f90: New test
>
> Backport from trunk.
> PR fortran/60795
> * gfortran.dg/deferred_character_14.f90: New test
>
> Backport from trunk.
> PR fortran/61147
> * gfortran.dg/deferred_character_11.f90: New test
>
> Backport from trunk.
> PR fortran/64324
> * gfortran.dg/deferred_character_9.f90: New test
>
>
>
>
>
> --
> The difference between genius and stupidity is; genius has its limits.
>
> Albert Einstein
> <check02.diff>
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] PR68241 - [meta-bug] Deferred-length character
2016-03-09 17:34 ` Dominique d'Humières
@ 2016-03-09 18:33 ` Paul Richard Thomas
2016-03-09 20:52 ` Paul Richard Thomas
0 siblings, 1 reply; 4+ messages in thread
From: Paul Richard Thomas @ 2016-03-09 18:33 UTC (permalink / raw)
To: Dominique d'Humières; +Cc: fortran, gcc-patches, Andre Vehreschild
Dominique,
Many thanks for the verification. I will update my tree forthwith,
bootstrap, regtest and commit.
Thanks
Paul
On 9 March 2016 at 18:34, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
> Dear Paul,
>
> As you said on IRC the patch needs -l to apply. After that the gcc-5 branch bootstrapped and regtested without any problem.
>
> Thanks,
>
> Dominique
>
>> Le 7 mars 2016 à 11:22, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
>>
>> Dear All,
>>
>> I had promised to get the 5-branch up to date in respect of deferred
>> character patches after then had been in place on trunk for "a few
>> weeks". Well, I got pulled away by PR69423 and have only now come back
>> to the earlier patch.
>>
>> The attached patch corresponds to trunk revisions 232450 and 233589.
>> They did not apply cleanly 5-branch in one or two places but it was no
>> big deal to put them right.
>>
>> Bootstrapped and regtested on FC21/x86_64 - OK for 5-branch?
>>
>> Best regards
>>
>> Paul
>>
>> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>>
>> Backport from trunk.
>> PR fortran/69423
>> * trans-decl.c (create_function_arglist): Deferred character
>> length functions, with and without declared results, address
>> the passed reference type as '.result' and the local string
>> length as '..result'.
>> (gfc_null_and_pass_deferred_len): Helper function to null and
>> return deferred string lengths, as needed.
>> (gfc_trans_deferred_vars): Call it, thereby reducing repeated
>> code, add call for deferred arrays and reroute pointer function
>> results. Avoid using 'tmp' for anything other that a temporary
>> tree by introducing 'type_of_array' for the arrayspec type.
>>
>> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>>
>> Backport from trunk.
>> PR fortran/64324
>> * resolve.c (check_uop_procedure): Prevent deferred length
>> characters from being trapped by assumed length error.
>>
>> Backport from trunk.
>> PR fortran/49630
>> PR fortran/54070
>> PR fortran/60593
>> PR fortran/60795
>> PR fortran/61147
>> PR fortran/64324
>> * trans-array.c (gfc_conv_scalarized_array_ref): Pass decl for
>> function as well as variable expressions.
>> (gfc_array_init_size): Add 'expr' as an argument. Use this to
>> correctly set the descriptor dtype for deferred characters.
>> (gfc_array_allocate): Add 'expr' to the call to
>> 'gfc_array_init_size'.
>> * trans.c (gfc_build_array_ref): Expand logic for setting span
>> to include indirect references to character lengths.
>> * trans-decl.c (gfc_get_symbol_decl): Ensure that deferred
>> result char lengths that are PARM_DECLs are indirectly
>> referenced both for directly passed and by reference.
>> (create_function_arglist): If the length type is a pointer type
>> then store the length as the 'passed_length' and make the char
>> length an indirect reference to it.
>> (gfc_trans_deferred_vars): If a character length has escaped
>> being set as an indirect reference, return it via the 'passed
>> length'.
>> * trans-expr.c (gfc_conv_procedure_call): The length of
>> deferred character length results is set TREE_STATIC and set to
>> zero.
>> (gfc_trans_assignment_1): Do not fix the rse string_length if
>> it is a variable, a parameter or an indirect reference. Add the
>> code to trap assignment of scalars to unallocated arrays.
>> * trans-stmt.c (gfc_trans_allocate): Remove 'def_str_len' and
>> all references to it. Instead, replicate the code to obtain a
>> explicitly defined string length and provide a value before
>> array allocation so that the dtype is correctly set.
>> trans-types.c (gfc_get_character_type): If the character length
>> is a pointer, use the indirect reference.
>>
>> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>>
>> Backport from trunk.
>> PR fortran/69423
>> * gfortran.dg/deferred_character_15.f90 : New test.
>>
>> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>>
>> Backport from trunk.
>> PR fortran/49630
>> * gfortran.dg/deferred_character_13.f90: New test for the fix
>> of comment 3 of the PR.
>>
>> Backport from trunk.
>> PR fortran/54070
>> * gfortran.dg/deferred_character_8.f90: New test
>> * gfortran.dg/allocate_error_5.f90: New test
>>
>> Backport from trunk.
>> PR fortran/60593
>> * gfortran.dg/deferred_character_10.f90: New test
>>
>> Backport from trunk.
>> PR fortran/60795
>> * gfortran.dg/deferred_character_14.f90: New test
>>
>> Backport from trunk.
>> PR fortran/61147
>> * gfortran.dg/deferred_character_11.f90: New test
>>
>> Backport from trunk.
>> PR fortran/64324
>> * gfortran.dg/deferred_character_9.f90: New test
>>
>>
>>
>>
>>
>> --
>> The difference between genius and stupidity is; genius has its limits.
>>
>> Albert Einstein
>> <check02.diff>
>
--
The difference between genius and stupidity is; genius has its limits.
Albert Einstein
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] PR68241 - [meta-bug] Deferred-length character
2016-03-09 18:33 ` Paul Richard Thomas
@ 2016-03-09 20:52 ` Paul Richard Thomas
0 siblings, 0 replies; 4+ messages in thread
From: Paul Richard Thomas @ 2016-03-09 20:52 UTC (permalink / raw)
To: Dominique d'Humières; +Cc: fortran, gcc-patches, Andre Vehreschild
Committed as revision 234093. Will close all the associated PRs.
Cheers
Paul
On 9 March 2016 at 19:33, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Dominique,
>
> Many thanks for the verification. I will update my tree forthwith,
> bootstrap, regtest and commit.
>
> Thanks
>
> Paul
>
> On 9 March 2016 at 18:34, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
>> Dear Paul,
>>
>> As you said on IRC the patch needs -l to apply. After that the gcc-5 branch bootstrapped and regtested without any problem.
>>
>> Thanks,
>>
>> Dominique
>>
>>> Le 7 mars 2016 à 11:22, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
>>>
>>> Dear All,
>>>
>>> I had promised to get the 5-branch up to date in respect of deferred
>>> character patches after then had been in place on trunk for "a few
>>> weeks". Well, I got pulled away by PR69423 and have only now come back
>>> to the earlier patch.
>>>
>>> The attached patch corresponds to trunk revisions 232450 and 233589.
>>> They did not apply cleanly 5-branch in one or two places but it was no
>>> big deal to put them right.
>>>
>>> Bootstrapped and regtested on FC21/x86_64 - OK for 5-branch?
>>>
>>> Best regards
>>>
>>> Paul
>>>
>>> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>>>
>>> Backport from trunk.
>>> PR fortran/69423
>>> * trans-decl.c (create_function_arglist): Deferred character
>>> length functions, with and without declared results, address
>>> the passed reference type as '.result' and the local string
>>> length as '..result'.
>>> (gfc_null_and_pass_deferred_len): Helper function to null and
>>> return deferred string lengths, as needed.
>>> (gfc_trans_deferred_vars): Call it, thereby reducing repeated
>>> code, add call for deferred arrays and reroute pointer function
>>> results. Avoid using 'tmp' for anything other that a temporary
>>> tree by introducing 'type_of_array' for the arrayspec type.
>>>
>>> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>>>
>>> Backport from trunk.
>>> PR fortran/64324
>>> * resolve.c (check_uop_procedure): Prevent deferred length
>>> characters from being trapped by assumed length error.
>>>
>>> Backport from trunk.
>>> PR fortran/49630
>>> PR fortran/54070
>>> PR fortran/60593
>>> PR fortran/60795
>>> PR fortran/61147
>>> PR fortran/64324
>>> * trans-array.c (gfc_conv_scalarized_array_ref): Pass decl for
>>> function as well as variable expressions.
>>> (gfc_array_init_size): Add 'expr' as an argument. Use this to
>>> correctly set the descriptor dtype for deferred characters.
>>> (gfc_array_allocate): Add 'expr' to the call to
>>> 'gfc_array_init_size'.
>>> * trans.c (gfc_build_array_ref): Expand logic for setting span
>>> to include indirect references to character lengths.
>>> * trans-decl.c (gfc_get_symbol_decl): Ensure that deferred
>>> result char lengths that are PARM_DECLs are indirectly
>>> referenced both for directly passed and by reference.
>>> (create_function_arglist): If the length type is a pointer type
>>> then store the length as the 'passed_length' and make the char
>>> length an indirect reference to it.
>>> (gfc_trans_deferred_vars): If a character length has escaped
>>> being set as an indirect reference, return it via the 'passed
>>> length'.
>>> * trans-expr.c (gfc_conv_procedure_call): The length of
>>> deferred character length results is set TREE_STATIC and set to
>>> zero.
>>> (gfc_trans_assignment_1): Do not fix the rse string_length if
>>> it is a variable, a parameter or an indirect reference. Add the
>>> code to trap assignment of scalars to unallocated arrays.
>>> * trans-stmt.c (gfc_trans_allocate): Remove 'def_str_len' and
>>> all references to it. Instead, replicate the code to obtain a
>>> explicitly defined string length and provide a value before
>>> array allocation so that the dtype is correctly set.
>>> trans-types.c (gfc_get_character_type): If the character length
>>> is a pointer, use the indirect reference.
>>>
>>> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>>>
>>> Backport from trunk.
>>> PR fortran/69423
>>> * gfortran.dg/deferred_character_15.f90 : New test.
>>>
>>> 2016-03-07 Paul Thomas <pault@gcc.gnu.org>
>>>
>>> Backport from trunk.
>>> PR fortran/49630
>>> * gfortran.dg/deferred_character_13.f90: New test for the fix
>>> of comment 3 of the PR.
>>>
>>> Backport from trunk.
>>> PR fortran/54070
>>> * gfortran.dg/deferred_character_8.f90: New test
>>> * gfortran.dg/allocate_error_5.f90: New test
>>>
>>> Backport from trunk.
>>> PR fortran/60593
>>> * gfortran.dg/deferred_character_10.f90: New test
>>>
>>> Backport from trunk.
>>> PR fortran/60795
>>> * gfortran.dg/deferred_character_14.f90: New test
>>>
>>> Backport from trunk.
>>> PR fortran/61147
>>> * gfortran.dg/deferred_character_11.f90: New test
>>>
>>> Backport from trunk.
>>> PR fortran/64324
>>> * gfortran.dg/deferred_character_9.f90: New test
>>>
>>>
>>>
>>>
>>>
>>> --
>>> The difference between genius and stupidity is; genius has its limits.
>>>
>>> Albert Einstein
>>> <check02.diff>
>>
>
>
>
> --
> The difference between genius and stupidity is; genius has its limits.
>
> Albert Einstein
--
The difference between genius and stupidity is; genius has its limits.
Albert Einstein
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2016-03-09 20:52 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-03-07 10:22 [Patch, fortran] PR68241 - [meta-bug] Deferred-length character Paul Richard Thomas
2016-03-09 17:34 ` Dominique d'Humières
2016-03-09 18:33 ` Paul Richard Thomas
2016-03-09 20:52 ` Paul Richard Thomas
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).