re PR fortran/72770 (ICE in make_ssa_name_fn, at tree-ssanames.c:263)
gcc/testsuite/ChangeLog: 2016-10-25 Andre Vehreschild <vehre@gcc.gnu.org> PR fortran/72770 * gfortran.dg/alloc_comp_class_5.f03: Added test again that caused this pr. gcc/fortran/ChangeLog: 2016-10-25 Andre Vehreschild <vehre@gcc.gnu.org> PR fortran/72770 * class.c (find_intrinsic_vtab): No longer encode the string length into vtype's name and use the char's kind for the size instead of the string_length time the size. * trans-array.c (gfc_conv_ss_descriptor): For deferred length char arrays the dynamically sized type needs to be declared. (build_class_array_ref): Address the i-th array element by multiplying it with the _vptr->_size and the _len to make sure char arrays are addressed correctly. * trans-expr.c (gfc_conv_intrinsic_to_class): Made comment more precise. From-SVN: r241528
This commit is contained in:
Andre Vehreschild
parent
6c3b5bf072
commit
cef026ecaf
6 changed files with 61 additions and 18 deletions
|
|
@ -1,3 +1,17 @@
|
|||
2016-10-25 Andre Vehreschild <vehre@gcc.gnu.org>
|
||||
|
||||
PR fortran/72770
|
||||
* class.c (find_intrinsic_vtab): No longer encode the string length
|
||||
into vtype's name and use the char's kind for the size instead of
|
||||
the string_length time the size.
|
||||
* trans-array.c (gfc_conv_ss_descriptor): For deferred length char
|
||||
arrays the dynamically sized type needs to be declared.
|
||||
(build_class_array_ref): Address the i-th array element by multiplying
|
||||
it with the _vptr->_size and the _len to make sure char arrays are
|
||||
addressed correctly.
|
||||
* trans-expr.c (gfc_conv_intrinsic_to_class): Made comment more
|
||||
precise.
|
||||
|
||||
2016-10-25 Cesar Philippidis <cesar@codesourcery.com>
|
||||
|
||||
* intrinsic.texi (cosd): New mathop.
|
||||
|
|
|
|||
|
|
@ -2515,11 +2515,6 @@ find_intrinsic_vtab (gfc_typespec *ts)
|
|||
gfc_namespace *ns;
|
||||
gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL;
|
||||
gfc_symbol *copy = NULL, *src = NULL, *dst = NULL;
|
||||
int charlen = 0;
|
||||
|
||||
if (ts->type == BT_CHARACTER && !ts->deferred && ts->u.cl && ts->u.cl->length
|
||||
&& ts->u.cl->length->expr_type == EXPR_CONSTANT)
|
||||
charlen = mpz_get_si (ts->u.cl->length->value.integer);
|
||||
|
||||
/* Find the top-level namespace. */
|
||||
for (ns = gfc_current_ns; ns; ns = ns->parent)
|
||||
|
|
@ -2530,12 +2525,10 @@ find_intrinsic_vtab (gfc_typespec *ts)
|
|||
{
|
||||
char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1];
|
||||
|
||||
if (ts->type == BT_CHARACTER)
|
||||
sprintf (tname, "%s_%d_%d", gfc_basic_typename (ts->type),
|
||||
charlen, ts->kind);
|
||||
else
|
||||
sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind);
|
||||
|
||||
/* Encode all types as TYPENAME_KIND_ including especially character
|
||||
arrays, whose length is now consistently stored in the _len component
|
||||
of the class-variable. */
|
||||
sprintf (tname, "%s_%d_", gfc_basic_typename (ts->type), ts->kind);
|
||||
sprintf (name, "__vtab_%s", tname);
|
||||
|
||||
/* Look for the vtab symbol in the top-level namespace only. */
|
||||
|
|
@ -2600,9 +2593,8 @@ find_intrinsic_vtab (gfc_typespec *ts)
|
|||
c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
|
||||
NULL,
|
||||
ts->type == BT_CHARACTER
|
||||
&& charlen == 0 ?
|
||||
ts->kind :
|
||||
(int)gfc_element_size (e));
|
||||
? ts->kind
|
||||
: (int)gfc_element_size (e));
|
||||
gfc_free_expr (e);
|
||||
|
||||
/* Add component _extends. */
|
||||
|
|
|
|||
|
|
@ -2681,6 +2681,20 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
|
|||
|
||||
if (base)
|
||||
{
|
||||
if (ss_info->expr->ts.type == BT_CHARACTER && !ss_info->expr->ts.deferred
|
||||
&& ss_info->expr->ts.u.cl->length == NULL)
|
||||
{
|
||||
/* Emit a DECL_EXPR for the variable sized array type in
|
||||
GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type
|
||||
sizes works correctly. */
|
||||
tree arraytype = TREE_TYPE (
|
||||
GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (info->descriptor)));
|
||||
if (! TYPE_NAME (arraytype))
|
||||
TYPE_NAME (arraytype) = build_decl (UNKNOWN_LOCATION, TYPE_DECL,
|
||||
NULL_TREE, arraytype);
|
||||
gfc_add_expr_to_block (block, build1 (DECL_EXPR, arraytype,
|
||||
TYPE_NAME (arraytype)));
|
||||
}
|
||||
/* Also the data pointer. */
|
||||
tmp = gfc_conv_array_data (se.expr);
|
||||
/* If this is a variable or address of a variable we use it directly.
|
||||
|
|
@ -3143,9 +3157,22 @@ build_class_array_ref (gfc_se *se, tree base, tree index)
|
|||
|
||||
size = gfc_class_vtab_size_get (decl);
|
||||
|
||||
/* For unlimited polymorphic entities then _len component needs to be
|
||||
multiplied with the size. If no _len component is present, then
|
||||
gfc_class_len_or_zero_get () return a zero_node. */
|
||||
tmp = gfc_class_len_or_zero_get (decl);
|
||||
if (!integer_zerop (tmp))
|
||||
size = fold_build2 (MULT_EXPR, TREE_TYPE (index),
|
||||
fold_convert (TREE_TYPE (index), size),
|
||||
fold_build2 (MAX_EXPR, TREE_TYPE (index),
|
||||
fold_convert (TREE_TYPE (index), tmp),
|
||||
fold_convert (TREE_TYPE (index),
|
||||
integer_one_node)));
|
||||
else
|
||||
size = fold_convert (TREE_TYPE (index), size);
|
||||
|
||||
/* Build the address of the element. */
|
||||
type = TREE_TYPE (TREE_TYPE (base));
|
||||
size = fold_convert (TREE_TYPE (index), size);
|
||||
offset = fold_build2_loc (input_location, MULT_EXPR,
|
||||
gfc_array_index_type,
|
||||
index, size);
|
||||
|
|
|
|||
|
|
@ -860,7 +860,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
|
|||
{
|
||||
ctree = gfc_class_len_get (var);
|
||||
/* When the actual arg is a char array, then set the _len component of the
|
||||
unlimited polymorphic entity, too. */
|
||||
unlimited polymorphic entity to the length of the string. */
|
||||
if (e->ts.type == BT_CHARACTER)
|
||||
{
|
||||
/* Start with parmse->string_length because this seems to be set to a
|
||||
|
|
|
|||
|
|
@ -1,3 +1,9 @@
|
|||
2016-10-25 Andre Vehreschild <vehre@gcc.gnu.org>
|
||||
|
||||
PR fortran/72770
|
||||
* gfortran.dg/alloc_comp_class_5.f03: Added test again that caused
|
||||
this pr.
|
||||
|
||||
2016-10-25 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR target/78102
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! { dg-do run }
|
||||
!
|
||||
! Contributed by Vladimir Fuka
|
||||
! Check that pr61337 is fixed.
|
||||
! Check that pr61337 and pr78053, which was caused by this testcase, is fixed.
|
||||
|
||||
module array_list
|
||||
|
||||
|
|
@ -39,8 +39,9 @@ program test_pr61337
|
|||
call add_item(a_list, [1, 2])
|
||||
call add_item(a_list, [3.0_8, 4.0_8])
|
||||
call add_item(a_list, [.true., .false.])
|
||||
call add_item(a_list, ["foo", "bar", "baz"])
|
||||
|
||||
if (size(a_list) /= 3) call abort()
|
||||
if (size(a_list) /= 4) call abort()
|
||||
do i = 1, size(a_list)
|
||||
call checkarr(a_list(i))
|
||||
end do
|
||||
|
|
@ -60,6 +61,9 @@ contains
|
|||
if (any(x /= [3.0_8, 4.0_8])) call abort()
|
||||
type is (logical)
|
||||
if (any(x .neqv. [.true., .false.])) call abort()
|
||||
type is (character(len=*))
|
||||
if (len(x) /= 3) call abort()
|
||||
if (any(x /= ["foo", "bar", "baz"])) call abort()
|
||||
class default
|
||||
call abort()
|
||||
end select
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue