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

re PR fortran/43256 ([OOP] TBP with missing optional arg) 

2010-03-08  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/43256
	* resolve.c (resolve_compcall): Don't set 'value.function.name' here
	for TBPs, otherwise they will not be resolved properly.
	(resolve_function): Use 'value.function.esym' instead of
        'value.function.name' to check if we're dealing with a TBP.
	(check_class_members): Set correct type of passed object for all TBPs,
	not only generic ones, except if the type is abstract.


2010-03-08  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/43256
	* gfortran.dg/typebound_call_13.f03: New.

From-SVN: r157272
This commit is contained in:
Janus Weil 2010-03-08 10:35:04 +01:00
parent 196c8bc8a3
commit b3d286bac2
4 changed files with 70 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -1,3 +1,13 @@
2010-03-08 Janus Weil <janus@gcc.gnu.org>
PR fortran/43256
* resolve.c (resolve_compcall): Don't set 'value.function.name' here
for TBPs, otherwise they will not be resolved properly.
(resolve_function): Use 'value.function.esym' instead of
'value.function.name' to check if we're dealing with a TBP.
(check_class_members): Set correct type of passed object for all TBPs,
not only generic ones, except if the type is abstract.
2010-03-04 Janus Weil <janus@gcc.gnu.org>
PR fortran/43244

25
gcc/fortran/resolve.c
View File

@ -2556,8 +2556,8 @@ resolve_function (gfc_expr *expr)
}
/* If this ia a deferred TBP with an abstract interface (which may
of course be referenced), expr->value.function.name will be set. */
if (sym && sym->attr.abstract && !expr->value.function.name)
of course be referenced), expr->value.function.esym will be set. */
if (sym && sym->attr.abstract && !expr->value.function.esym)
{
gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
sym->name, &expr->where);
@ -5124,7 +5124,7 @@ resolve_compcall (gfc_expr* e, bool fcn)
return FAILURE;
e->value.function.actual = newactual;
e->value.function.name = e->value.compcall.name;
e->value.function.name = NULL;
e->value.function.esym = target->n.sym;
e->value.function.class_esym = NULL;
e->value.function.isym = NULL;
@ -5178,18 +5178,17 @@ check_class_members (gfc_symbol *derived)
return;
}
if (tbp->n.tb->is_generic)
/* If we have to match a passed class member, force the actual
expression to have the correct type. */
if (!tbp->n.tb->nopass)
{
/* If we have to match a passed class member, force the actual
expression to have the correct type. */
if (!tbp->n.tb->nopass)
{
if (e->value.compcall.base_object == NULL)
e->value.compcall.base_object =
extract_compcall_passed_object (e);
if (e->value.compcall.base_object == NULL)
e->value.compcall.base_object = extract_compcall_passed_object (e);
e->value.compcall.base_object->ts.type = BT_DERIVED;
e->value.compcall.base_object->ts.u.derived = derived;
if (!derived->attr.abstract)
{
e->value.compcall.base_object->ts.type = BT_DERIVED;
e->value.compcall.base_object->ts.u.derived = derived;
}
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2010-03-08 Janus Weil <janus@gcc.gnu.org>
PR fortran/43256
* gfortran.dg/typebound_call_13.f03: New.
2010-03-05 Eric Botcazou <ebotcazou@adacore.com>
* lib/plugin-support.exp (plugin-test-execute): Use PLUGINCC in lieu

43
gcc/testsuite/gfortran.dg/typebound_call_13.f03 Normal file
View File

@ -0,0 +1,43 @@
! { dg-do run }
!
! PR 43256: [OOP] TBP with missing optional arg
!
! Contributed by Janus Weil
module module_myobj
implicit none
type :: myobj
contains
procedure, nopass :: myfunc
end type
contains
integer function myfunc(status)
integer, optional :: status
if (present(status)) then
myfunc = 1
else
myfunc = 2
end if
end function
end module
program test_optional
use :: module_myobj
implicit none
integer :: res = 0
type(myobj) :: myinstance
res = myinstance%myfunc()
if (res /= 2) call abort()
end program
! { dg-final { cleanup-modules "module_myobj" } }