OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/41714 ([OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE) 

2009-10-26  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41714
	* gimple.h (tree_annotate_all_with_location): Remove prototype.
	* gimplify.c (tree_should_carry_location_p,
	tree_annotate_one_with_location,tree_annotate_all_with_location):
	Remove obsolete functions.


2009-10-26  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41714
	* trans.c (gfc_trans_code): Remove call to
	'tree_annotate_all_with_location'. Location should already be set.
	* trans-openmp.c (gfc_trans_omp_workshare): Ditto.
	* trans-stmt.c (gfc_trans_allocate): Do correct data initialization for
	CLASS variables with SOURCE tag, plus some cleanup.


2009-10-26  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41714
	* gfortran.dg/class_allocate_4.f03: New test.

From-SVN: r153547
This commit is contained in:
Janus Weil 2009-10-26 10:08:03 +01:00
parent b0418319a0
commit 60f5ed26b3
9 changed files with 67 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ChangeLog
View File

@ -1,3 +1,11 @@
2009-10-26 Janus Weil <janus@gcc.gnu.org>
PR fortran/41714
* gimple.h (tree_annotate_all_with_location): Remove prototype.
* gimplify.c (tree_should_carry_location_p,
tree_annotate_one_with_location,tree_annotate_all_with_location):
Remove obsolete functions.
2009-10-25 Kaz Kojima <kkojima@gcc.gnu.org>
PR target/41813

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
2009-10-26 Janus Weil <janus@gcc.gnu.org>
PR fortran/41714
* trans.c (gfc_trans_code): Remove call to
'tree_annotate_all_with_location'. Location should already be set.
* trans-openmp.c (gfc_trans_omp_workshare): Ditto.
* trans-stmt.c (gfc_trans_allocate): Do correct data initialization for
CLASS variables with SOURCE tag, plus some cleanup.
2009-10-24 Janus Weil <janus@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>

5
gcc/fortran/trans-openmp.c
View File

@ -1641,11 +1641,6 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
{
if (TREE_CODE (res) == STATEMENT_LIST)
tree_annotate_all_with_location (&res, input_location);
else
SET_EXPR_LOCATION (res, input_location);
if (prev_singleunit)
{
if (ompws_flags & OMPWS_CURR_SINGLEUNIT)

70
gcc/fortran/trans-stmt.c
View File

@ -3983,12 +3983,13 @@ gfc_trans_allocate (gfc_code * code)
tree stat;
tree pstat;
tree error_label;
tree memsz;
stmtblock_t block;
if (!code->ext.alloc.list)
return NULL_TREE;
pstat = stat = error_label = tmp = NULL_TREE;
pstat = stat = error_label = tmp = memsz = NULL_TREE;
gfc_start_block (&block);
@ -4032,19 +4033,19 @@ gfc_trans_allocate (gfc_code * code)
gfc_init_se (&se_sz, NULL);
gfc_conv_expr (&se_sz, sz);
gfc_free_expr (sz);
tmp = se_sz.expr;
memsz = se_sz.expr;
}
else if (code->expr3 && code->expr3->ts.type != BT_CLASS)
tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr3->ts));
memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr3->ts));
else if (code->ext.alloc.ts.type != BT_UNKNOWN)
tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
else
tmp = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
memsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
if (expr->ts.type == BT_CHARACTER && tmp == NULL_TREE)
tmp = se.string_length;
if (expr->ts.type == BT_CHARACTER && memsz == NULL_TREE)
memsz = se.string_length;
tmp = gfc_allocate_with_status (&se.pre, tmp, pstat);
tmp = gfc_allocate_with_status (&se.pre, memsz, pstat);
tmp = fold_build2 (MODIFY_EXPR, void_type_node, se.expr,
fold_convert (TREE_TYPE (se.expr), tmp));
gfc_add_expr_to_block (&se.pre, tmp);
@ -4075,21 +4076,17 @@ gfc_trans_allocate (gfc_code * code)
if (code->expr3)
{
gfc_expr *rhs = gfc_copy_expr (code->expr3);
if (rhs->ts.type == BT_CLASS)
if (al->expr->ts.type == BT_CLASS)
{
gfc_se dst,src,len;
gfc_expr *sz;
gfc_add_component_ref (rhs, "$data");
sz = gfc_copy_expr (code->expr3);
gfc_add_component_ref (sz, "$size");
gfc_se dst,src;
if (rhs->ts.type == BT_CLASS)
gfc_add_component_ref (rhs, "$data");
gfc_init_se (&dst, NULL);
gfc_init_se (&src, NULL);
gfc_init_se (&len, NULL);
gfc_conv_expr (&dst, expr);
gfc_conv_expr (&src, rhs);
gfc_conv_expr (&len, sz);
gfc_free_expr (sz);
tmp = gfc_build_memcpy_call (dst.expr, src.expr, len.expr);
gfc_add_block_to_block (&block, &src.pre);
tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
}
else
tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr),
@ -4108,8 +4105,7 @@ gfc_trans_allocate (gfc_code * code)
gfc_conv_expr (&dst, expr);
gfc_conv_expr (&src, init_e);
gfc_add_block_to_block (&block, &src.pre);
tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
tmp = gfc_build_memcpy_call (dst.expr, src.expr, tmp);
tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
gfc_add_expr_to_block (&block, tmp);
}
/* Add default initializer for those derived types that need them. */
@ -4127,6 +4123,7 @@ gfc_trans_allocate (gfc_code * code)
if (expr->ts.type == BT_CLASS)
{
gfc_expr *lhs,*rhs;
gfc_se lse;
/* Initialize VINDEX for CLASS objects. */
lhs = gfc_expr_to_initialize (expr);
gfc_add_component_ref (lhs, "$vindex");
@ -4158,36 +4155,11 @@ gfc_trans_allocate (gfc_code * code)
/* Initialize SIZE for CLASS objects. */
lhs = gfc_expr_to_initialize (expr);
gfc_add_component_ref (lhs, "$size");
rhs = NULL;
if (code->expr3 && code->expr3->ts.type == BT_CLASS)
{
/* Size must be determined at run time. */
rhs = gfc_copy_expr (code->expr3);
gfc_add_component_ref (rhs, "$size");
tmp = gfc_trans_assignment (lhs, rhs, false);
gfc_add_expr_to_block (&block, tmp);
}
else
{
/* Size is fixed at compile time. */
gfc_typespec *ts;
gfc_se lse;
gfc_init_se (&lse, NULL);
gfc_conv_expr (&lse, lhs);
if (code->expr3)
ts = &code->expr3->ts;
else if (code->ext.alloc.ts.type == BT_DERIVED)
ts = &code->ext.alloc.ts;
else if (expr->ts.type == BT_CLASS)
ts = &expr->ts.u.derived->components->ts;
else
ts = &expr->ts;
tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (ts));
gfc_add_modify (&block, lse.expr,
fold_convert (TREE_TYPE (lse.expr), tmp));
}
gfc_init_se (&lse, NULL);
gfc_conv_expr (&lse, lhs);
gfc_add_modify (&block, lse.expr,
fold_convert (TREE_TYPE (lse.expr), memsz));
gfc_free_expr (lhs);
gfc_free_expr (rhs);
}
}

4
gcc/fortran/trans.c
View File

@ -1281,9 +1281,7 @@ gfc_trans_code (gfc_code * code)
if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
{
if (TREE_CODE (res) == STATEMENT_LIST)
tree_annotate_all_with_location (&res, input_location);
else
if (TREE_CODE (res) != STATEMENT_LIST)
SET_EXPR_LOCATION (res, input_location);
/* Add the new statement to the block. */

1
gcc/gimple.h
View File

@ -939,7 +939,6 @@ extern tree create_tmp_var (tree, const char *);
extern tree get_initialized_tmp_var (tree, gimple_seq *, gimple_seq *);
extern tree get_formal_tmp_var (tree, gimple_seq *);
extern void declare_vars (tree, gimple, bool);
extern void tree_annotate_all_with_location (tree *, location_t);
extern void annotate_all_with_location (gimple_seq, location_t);
/* Validation of GIMPLE expressions. Note that these predicates only check

50
gcc/gimplify.c
View File

@ -777,23 +777,6 @@ should_carry_location_p (gimple gs)
return true;
}
/* Same, but for a tree. */
static bool
tree_should_carry_location_p (const_tree stmt)
{
/* Don't emit a line note for a label. We particularly don't want to
emit one for the break label, since it doesn't actually correspond
to the beginning of the loop/switch. */
if (TREE_CODE (stmt) == LABEL_EXPR)
return false;
/* Do not annotate empty statements, since it confuses gcov. */
if (!TREE_SIDE_EFFECTS (stmt))
return false;
return true;
}
/* Return true if a location should not be emitted for this statement
by annotate_one_with_location. */
@ -826,16 +809,6 @@ annotate_one_with_location (gimple gs, location_t location)
gimple_set_location (gs, location);
}
/* Same, but for tree T. */
static void
tree_annotate_one_with_location (tree t, location_t location)
{
if (CAN_HAVE_LOCATION_P (t)
&& ! EXPR_HAS_LOCATION (t) && tree_should_carry_location_p (t))
SET_EXPR_LOCATION (t, location);
}
/* Set LOCATION for all the statements after iterator GSI in sequence
SEQ. If GSI is pointing to the end of the sequence, start with the
@ -872,29 +845,6 @@ annotate_all_with_location (gimple_seq stmt_p, location_t location)
}
}
/* Same, but for statement or statement list in *STMT_P. */
void
tree_annotate_all_with_location (tree *stmt_p, location_t location)
{
tree_stmt_iterator i;
if (!*stmt_p)
return;
for (i = tsi_start (*stmt_p); !tsi_end_p (i); tsi_next (&i))
{
tree t = tsi_stmt (i);
/* Assuming we've already been gimplified, we shouldn't
see nested chaining constructs anymore. */
gcc_assert (TREE_CODE (t) != STATEMENT_LIST
&& TREE_CODE (t) != COMPOUND_EXPR);
tree_annotate_one_with_location (t, location);
}
}
/* Similar to copy_tree_r() but do not copy SAVE_EXPR or TARGET_EXPR nodes.
These nodes model computations that should only be done once. If we

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2009-10-26 Janus Weil <janus@gcc.gnu.org>
PR fortran/41714
* gfortran.dg/class_allocate_4.f03: New test.
2009-10-24 Adam Nemet <anemet@caviumnetworks.com>
* gcc.target/mips/mult-1.c: New test.

23
gcc/testsuite/gfortran.dg/class_allocate_4.f03 Normal file
View File

@ -0,0 +1,23 @@
! { dg-do run }
!
! PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
type t
integer :: i
end type t
type, extends(t) :: t2
integer :: j
end type t2
class(t), allocatable :: a
allocate(a, source=t2(1,2))
print *,a%i
if(a%i /= 1) call abort()
select type (a)
type is (t2)
print *,a%j
if(a%j /= 2) call abort()
end select
end