public inbox for gcc-bugs@sourceware.org
help / color / mirror / Atom feed
From: "janus at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>
To: gcc-bugs@gcc.gnu.org
Subject: [Bug fortran/47194] [OOP] EXTENDS_TYPE_OF still returns the wrong result if the polymorphic variable is unallocated
Date: Thu, 06 Jan 2011 18:32:00 -0000 [thread overview]
Message-ID: <bug-47194-4-x0aahibBds@http.gcc.gnu.org/bugzilla/> (raw)
In-Reply-To: <bug-47194-4@http.gcc.gnu.org/bugzilla/>
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=47194
janus at gcc dot gnu.org changed:
What |Removed |Added
----------------------------------------------------------------------------
Status|UNCONFIRMED |ASSIGNED
Last reconfirmed| |2011.01.06 18:29:25
AssignedTo|unassigned at gcc dot |janus at gcc dot gnu.org
|gnu.org |
Ever Confirmed|0 |1
--- Comment #1 from janus at gcc dot gnu.org 2011-01-06 18:29:25 UTC ---
(In reply to comment #0)
> Found when looking at PR 41580 -- and related to PR47180, PR47024 and PR47189.
Seems we opened a nice can of worms here ;)
Patch:
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (revision 168539)
+++ gcc/fortran/trans-stmt.c (working copy)
@@ -4738,7 +4738,6 @@ gfc_trans_deallocate (gfc_code *code)
{
gfc_se se;
gfc_alloc *al;
- gfc_expr *expr;
tree apstat, astat, pstat, stat, tmp;
stmtblock_t block;
@@ -4766,9 +4765,12 @@ gfc_trans_deallocate (gfc_code *code)
for (al = code->ext.alloc.list; al != NULL; al = al->next)
{
- expr = al->expr;
+ gfc_expr *expr = gfc_copy_expr (al->expr);
gcc_assert (expr->expr_type == EXPR_VARIABLE);
+ if (expr->ts.type == BT_CLASS)
+ gfc_add_data_component (expr);
+
gfc_init_se (&se, NULL);
gfc_start_block (&se.pre);
@@ -4797,6 +4799,7 @@ gfc_trans_deallocate (gfc_code *code)
}
}
tmp = gfc_array_deallocate (se.expr, pstat, expr);
+ gfc_add_expr_to_block (&se.pre, tmp);
}
else
{
@@ -4804,13 +4807,26 @@ gfc_trans_deallocate (gfc_code *code)
expr, expr->ts);
gfc_add_expr_to_block (&se.pre, tmp);
+ /* Set to zero after deallocation. */
tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
se.expr,
build_int_cst (TREE_TYPE (se.expr), 0));
+ gfc_add_expr_to_block (&se.pre, tmp);
+
+ if (al->expr->ts.type == BT_CLASS)
+ {
+ /* Reset _vptr component. */
+ gfc_expr *rhs, *lhs = gfc_copy_expr (al->expr);
+ gfc_symbol *vtab = gfc_find_derived_vtab (al->expr->ts.u.derived);
+ gfc_add_vptr_component (lhs);
+ rhs = gfc_lval_expr_from_sym (vtab);
+ tmp = gfc_trans_pointer_assignment (lhs, rhs);
+ gfc_add_expr_to_block (&se.pre, tmp);
+ gfc_free_expr (lhs);
+ gfc_free_expr (rhs);
+ }
}
- gfc_add_expr_to_block (&se.pre, tmp);
-
/* Keep track of the number of failed deallocations by adding stat
of the last deallocation to the running total. */
if (code->expr1 || code->expr2)
@@ -4822,7 +4838,7 @@ gfc_trans_deallocate (gfc_code *code)
tmp = gfc_finish_block (&se.pre);
gfc_add_expr_to_block (&block, tmp);
-
+ gfc_free_expr (expr);
}
/* Set STAT. */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 168539)
+++ gcc/fortran/resolve.c (working copy)
@@ -6417,12 +6417,6 @@ resolve_deallocate_expr (gfc_expr *e)
if (gfc_check_vardef_context (e, false, _("DEALLOCATE object")) == FAILURE)
return FAILURE;
- if (e->ts.type == BT_CLASS)
- {
- /* Only deallocate the DATA component. */
- gfc_add_data_component (e);
- }
-
return SUCCESS;
}
next prev parent reply other threads:[~2011-01-06 18:29 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-01-06 17:50 [Bug fortran/47194] New: " burnus at gcc dot gnu.org
2011-01-06 18:32 ` janus at gcc dot gnu.org [this message]
2011-01-07 12:25 ` [Bug fortran/47194] " janus at gcc dot gnu.org
2011-01-07 17:48 ` janus at gcc dot gnu.org
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=bug-47194-4-x0aahibBds@http.gcc.gnu.org/bugzilla/ \
--to=gcc-bugzilla@gcc.gnu.org \
--cc=gcc-bugs@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).