* [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs49630, 54070, 60593, 60795, 61147, 63232 and 64324
@ 2016-01-09 19:33 Paul Richard Thomas
2016-01-15 20:44 ` Paul Richard Thomas
0 siblings, 1 reply; 2+ messages in thread
From: Paul Richard Thomas @ 2016-01-09 19:33 UTC (permalink / raw)
To: fortran, gcc-patches; +Cc: Steve Kargl, Damian Rouson, Dominique Dhumieres
[-- Attachment #1: Type: text/plain, Size: 3719 bytes --]
Dear All,
This is a further instalment of deferred character length fixes. I
have listed the status of all the deferred length PRs that I know of
in an attachment. As far as I can see, there are five left that are
really concerned with deferred character length functionality.
In terms of the number of PRs fixed, this patch is rather less
impressive than it looks. Essentially four things have been fixed:
(i) Deferred character length results are passed by reference and so,
within the procedure itself, they are consistently indirectly
referenced;
(ii) The deferred character types are made correctly by indirectly
referencing the character length;
(iii) Array references to deferred character arrays use pointer arithmetic; and
(iv) Scalar assignments to unallocated arrays are trapped at runtime
with -fcheck=mem.
A minor tweak was required to fix PR64324 because deferred length
characters were being misidentified as assumed length.
The ChangeLog is clear as to what has been done. The only point on
which I am uncertain is that of making the length parameter of
deferred character length procedure results TREE_STATIC. This was
required to make the patch function correctly at any level of
optimization. Is this the best and/or only way of doing this?
Bootstrapped and regtested on FC21/x86_64 - OK for trunk and, after a
decent interval, 5 branch?
Cheers
Paul
2016-01-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/64324
* resolve.c (check_uop_procedure): Prevent deferred length
characters from being trapped by assumed length error.
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.
* 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-01-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/49630
* gfortran.dg/deferred_character_13.f90: New test for the fix
of comment 3 of the PR.
PR fortran/54070
* gfortran.dg/deferred_character_8.f90: New test
* gfortran.dg/allocate_error_5.f90: New test
PR fortran/60593
* gfortran.dg/deferred_character_10.f90: New test
PR fortran/60795
* gfortran.dg/deferred_character_14.f90: New test
PR fortran/61147
* gfortran.dg/deferred_character_11.f90: New test
PR fortran/64324
* gfortran.dg/deferred_character_9.f90: New test
[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 23525 bytes --]
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 232163)
--- gcc/fortran/resolve.c (working copy)
*************** check_uop_procedure (gfc_symbol *sym, lo
*** 15320,15328 ****
}
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);
--- 15320,15328 ----
}
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 232163)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3165,3171 ****
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);
--- 3165,3172 ----
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);
Index: gcc/fortran/trans.c
===================================================================
*** gcc/fortran/trans.c (revision 232163)
--- gcc/fortran/trans.c (working copy)
*************** gfc_build_array_ref (tree base, tree off
*** 335,344 ****
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;
--- 335,347 ----
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
*** 354,360 ****
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)
--- 357,364 ----
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/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c (revision 232163)
--- gcc/fortran/trans-decl.c (working copy)
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 1377,1384 ****
&& 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
--- 1377,1384 ----
&& 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)
*** 1420,1428 ****
--- 1420,1431 ----
/* 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)
*** 1431,1436 ****
--- 1434,1443 ----
&& 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
*** 2264,2269 ****
--- 2271,2283 ----
type = gfc_sym_type (arg);
arg->backend_decl = backend_decl;
type = build_reference_type (type);
+
+ if (POINTER_TYPE_P (len_type))
+ {
+ sym->ts.u.cl->passed_length = length;
+ sym->ts.u.cl->backend_decl =
+ build_fold_indirect_ref_loc (input_location, length);
+ }
}
}
*************** create_function_arglist (gfc_symbol * sy
*** 2347,2353 ****
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. */
--- 2361,2370 ----
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. */
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 3975,3986 ****
--- 3992,4010 ----
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)
+ {
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)
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 232163)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5942,5947 ****
--- 5942,5950 ----
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
*** 9263,9269 ****
}
/* 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;
--- 9266,9275 ----
}
/* 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
*** 9277,9283 ****
--- 9283,9314 ----
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 232163)
--- gcc/fortran/trans-stmt.c (working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 5298,5304 ****
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
--- 5298,5303 ----
*************** gfc_trans_allocate (gfc_code * code)
*** 5688,5694 ****
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);
}
}
--- 5687,5692 ----
*************** gfc_trans_allocate (gfc_code * code)
*** 5741,5756 ****
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
--- 5739,5744 ----
*************** gfc_trans_allocate (gfc_code * code)
*** 5888,5893 ****
--- 5876,5895 ----
/* 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 232163)
--- gcc/fortran/trans-types.c (working copy)
*************** gfc_get_character_type (int kind, gfc_ch
*** 1045,1050 ****
--- 1045,1052 ----
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/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_8.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_8.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/deferred_character_8.f90 (working copy)
***************
*** 0 ****
--- 1,73 ----
+ ! { 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.
+ !
+ ! 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)
+ 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
+ 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
+
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
[-- Attachment #3: status.txt --]
[-- Type: text/plain, Size: 3083 bytes --]
54070 [4.9/5/6 Regression] Wrong code with allocatable deferred-length (array) function results
Working patch, original problem now fixed. deferred_character_8.f90
and allocate_error_5.f90
66408 deferred-length character & overloaded assignment
Assigned to me and fixed on trunk. Part of first commit - apply to 5-branch
46299 Diagnose specification expressions involving host-associated vars with deferred bounds
NOT YET FIXED Off subject but picked up because of "deferred"
49630 [OOP] ICE on obsolescent deferred-length type bound character function
Check that the test in comment #3 works - deferred_character_13.f90
49954 ICE assigning concat expression to an array deferred-length string (realloc on assignment)
Assigned to me and fixed on trunk. Part of first commit - apply to 5-branch
55735 ICE with deferred-length strings in COMMON
NOT YET FIXED This should be fixable relatively easily. Will need pointer/descriptor + string_length combination.
57910 ICE (segfault) with deferred-length strings 2015-11-06
NOT YET FIXED A vicious looking thing involving a mixtire of ISO-C-Binding and deferred length characters
Still fails.
60458 Error message on associate: deferred type parameter and requires either the pointer or allocatable attribute
NOT YET FIXED Worth fixing if possible. Needs work in trans-decl.c
60593 ICE with deferred length variable in FORALL
See comment #2 for simplified testcase - deferred_character_10.f90
61147 Incorrect behavior using function that returns deferred length character pointer
Should have been fixed - deferred_character_11.f90
63232 Deferred length character field of derived type looses its value when used in subroutine call
High priority - deferred_character_12.f90
63667 ICE with DEFERRED procedure
NOT YET FIXED Fixed???? No. Correct error then ICE. Adding pointer attribute allows compilation
64324 Deferred character specific functions not permitted in generic operator interface
Should be fixable - deferred_character_9.f90
65677 Incomplete assignment on deferred-length character variable
NOT YET FIXED Problem with ADJUSTL? Post workarounds
67674 Incorrect result or ICE for deferred-length character component
Assigned to me and fixed on trunk. Part of first commit - apply to 5-branch
68216 [F2003] IO problem with allocatable, deferred character length arrays
Assigned to me and fixed on trunk. Part of first commit - apply to 5-branch
68241 [meta-bug] Deferred-length character 2015-11-06
17 bugs found. In addition, PR68241 contains:
50221 Allocatable string length fails with array assignment
Assigned to me and fixed on trunk. Part of first commit - apply to 5-branch
63932 posible problem with allocatable character(:)
Assigned to me and fixed on trunk. Part of first commit - apply to 5-branch
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs49630, 54070, 60593, 60795, 61147, 63232 and 64324
2016-01-09 19:33 [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs49630, 54070, 60593, 60795, 61147, 63232 and 64324 Paul Richard Thomas
@ 2016-01-15 20:44 ` Paul Richard Thomas
0 siblings, 0 replies; 2+ messages in thread
From: Paul Richard Thomas @ 2016-01-15 20:44 UTC (permalink / raw)
To: fortran, gcc-patches; +Cc: Steve Kargl, Damian Rouson, Dominique Dhumieres
Dear All,
Following an exchange with Dominique on #gfortran, I fixed PR54070
comment #23. The changes are in trans-array.c and are listed in the
ChangeLogs below.
Committed to trunk as revision 232450. I will wait some weeks before
committing to 5-branch. This patch should have made deferred character
length a rather more usable feature. They still don't work in common
blocks (PR55735) and there are still problems with them as associate
variables (PR60458). I will endeavour to fix these PRs next.
Thanks, Dominique!
Paul
On 9 January 2016 at 20:33, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> Dear All,
>
> This is a further instalment of deferred character length fixes. I
> have listed the status of all the deferred length PRs that I know of
> in an attachment. As far as I can see, there are five left that are
> really concerned with deferred character length functionality.
>
> In terms of the number of PRs fixed, this patch is rather less
> impressive than it looks. Essentially four things have been fixed:
> (i) Deferred character length results are passed by reference and so,
> within the procedure itself, they are consistently indirectly
> referenced;
> (ii) The deferred character types are made correctly by indirectly
> referencing the character length;
> (iii) Array references to deferred character arrays use pointer arithmetic; and
> (iv) Scalar assignments to unallocated arrays are trapped at runtime
> with -fcheck=mem.
>
> A minor tweak was required to fix PR64324 because deferred length
> characters were being misidentified as assumed length.
>
> The ChangeLog is clear as to what has been done. The only point on
> which I am uncertain is that of making the length parameter of
> deferred character length procedure results TREE_STATIC. This was
> required to make the patch function correctly at any level of
> optimization. Is this the best and/or only way of doing this?
>
> Bootstrapped and regtested on FC21/x86_64 - OK for trunk and, after a
> decent interval, 5 branch?
>
> Cheers
>
> Paul
>
> 2016-01-09 Paul Thomas <pault@gcc.gnu.org>
>
> PR fortran/64324
> * resolve.c (check_uop_procedure): Prevent deferred length
> characters from being trapped by assumed length error.
>
> 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.
> * 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-01-09 Paul Thomas <pault@gcc.gnu.org>
>
> PR fortran/49630
> * gfortran.dg/deferred_character_13.f90: New test for the fix
> of comment 3 of the PR.
>
> PR fortran/54070
> * gfortran.dg/deferred_character_8.f90: New test
> * gfortran.dg/allocate_error_5.f90: New test
>
> PR fortran/60593
> * gfortran.dg/deferred_character_10.f90: New test
>
> PR fortran/60795
> * gfortran.dg/deferred_character_14.f90: New test
>
> PR fortran/61147
> * gfortran.dg/deferred_character_11.f90: New test
>
> PR fortran/64324
> * gfortran.dg/deferred_character_9.f90: New test
--
The difference between genius and stupidity is; genius has its limits.
Albert Einstein
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2016-01-15 20:44 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-01-09 19:33 [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs49630, 54070, 60593, 60795, 61147, 63232 and 64324 Paul Richard Thomas
2016-01-15 20:44 ` 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).