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

resolve.c (check_typebound_baseobject): Free local expr before returning. 

2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>

	* resolve.c (check_typebound_baseobject): Free local expr before
	returning.

From-SVN: r165034
This commit is contained in:
Mikael Morin 2010-10-06 14:52:02 +00:00
parent 3bf9ef1bc4
commit 99b41d521c
2 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
2010-10-06 Mikael Morin <mikael@gcc.gnu.org>
* resolve.c (check_typebound_baseobject): Free local expr before
returning.
2010-10-06 Mikael Morin <mikael@gcc.gnu.org> 2010-10-06 Mikael Morin <mikael@gcc.gnu.org>
* primary.c (gfc_match_structure_constructor): Invert the assert logic. * primary.c (gfc_match_structure_constructor): Invert the assert logic.

13
gcc/fortran/resolve.c
View File

@ -5404,6 +5404,7 @@ static gfc_try
check_typebound_baseobject (gfc_expr* e) check_typebound_baseobject (gfc_expr* e)
{ {
gfc_expr* base; gfc_expr* base;
gfc_try return_value = FAILURE;
base = extract_compcall_passed_object (e); base = extract_compcall_passed_object (e);
if (!base) if (!base)
@ -5415,7 +5416,7 @@ check_typebound_baseobject (gfc_expr* e)
{ {
gfc_error ("Base object for type-bound procedure call at %L is of" gfc_error ("Base object for type-bound procedure call at %L is of"
" ABSTRACT type '%s'", &e->where, base->ts.u.derived->name); " ABSTRACT type '%s'", &e->where, base->ts.u.derived->name);
return FAILURE; goto cleanup;
} }
/* If the procedure called is NOPASS, the base object must be scalar. */ /* If the procedure called is NOPASS, the base object must be scalar. */
@ -5423,7 +5424,7 @@ check_typebound_baseobject (gfc_expr* e)
{ {
gfc_error ("Base object for NOPASS type-bound procedure call at %L must" gfc_error ("Base object for NOPASS type-bound procedure call at %L must"
" be scalar", &e->where); " be scalar", &e->where);
return FAILURE; goto cleanup;
} }
/* FIXME: Remove once PR 41177 (this problem) is fixed completely. */ /* FIXME: Remove once PR 41177 (this problem) is fixed completely. */
@ -5431,10 +5432,14 @@ check_typebound_baseobject (gfc_expr* e)
{ {
gfc_error ("Non-scalar base object at %L currently not implemented", gfc_error ("Non-scalar base object at %L currently not implemented",
&e->where); &e->where);
return FAILURE; goto cleanup;
} }
return SUCCESS; return_value = SUCCESS;
cleanup:
gfc_free_expr (base);
return return_value;
} }