procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/37425 (Fortran 2003: GENERIC bindings as operators)

Browse source 
2009-08-17  Daniel Kraft  <d@domob.eu>

	PR fortran/37425
	* resolve.c (get_checked_tb_operator_target): New routine to do checks
	on type-bound operators in common between intrinsic and user operators.
	(resolve_typebound_intrinsic_op): Call it.
	(resolve_typebound_user_op): Ditto.

2009-08-17  Daniel Kraft  <d@domob.eu>

	PR fortran/37425
	* gfortran.dg/typebound_operator_2.f03: Test for error with illegal
	NOPASS bindings as operators.

From-SVN: r150856
This commit is contained in:
Daniel Kraft 2009-08-17 20:55:30 +02:00 • committed by Daniel Kraft
parent 709a22df79
commit b325faf9d9
4 changed files with 50 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -1,3 +1,11 @@
2009-08-17 Daniel Kraft <d@domob.eu>
PR fortran/37425
* resolve.c (get_checked_tb_operator_target): New routine to do checks
on type-bound operators in common between intrinsic and user operators.
(resolve_typebound_intrinsic_op): Call it.
(resolve_typebound_user_op): Ditto.
2009-08-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/41075

35
gcc/fortran/resolve.c
View file

@ -8965,6 +8965,29 @@ resolve_typebound_generic (gfc_symbol* derived, gfc_symtree* st)
}
/* Retrieve the target-procedure of an operator binding and do some checks in
common for intrinsic and user-defined type-bound operators. */
static gfc_symbol*
get_checked_tb_operator_target (gfc_tbp_generic* target, locus where)
{
gfc_symbol* target_proc;
gcc_assert (target->specific && !target->specific->is_generic);
target_proc = target->specific->u.specific->n.sym;
gcc_assert (target_proc);
/* All operator bindings must have a passed-object dummy argument. */
if (target->specific->nopass)
{
gfc_error ("Type-bound operator at %L can't be NOPASS", &where);
return NULL;
}
return target_proc;
}
/* Resolve a type-bound intrinsic operator. */
static gfc_try
@ -8998,9 +9021,9 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op,
{
gfc_symbol* target_proc;
gcc_assert (target->specific && !target->specific->is_generic);
target_proc = target->specific->u.specific->n.sym;
gcc_assert (target_proc);
target_proc = get_checked_tb_operator_target (target, p->where);
if (!target_proc)
return FAILURE;
if (!gfc_check_operator_interface (target_proc, op, p->where))
return FAILURE;
@ -9059,9 +9082,9 @@ resolve_typebound_user_op (gfc_symtree* stree)
{
gfc_symbol* target_proc;
gcc_assert (target->specific && !target->specific->is_generic);
target_proc = target->specific->u.specific->n.sym;
gcc_assert (target_proc);
target_proc = get_checked_tb_operator_target (target, stree->n.tb->where);
if (!target_proc)
goto error;
if (check_uop_procedure (target_proc, stree->n.tb->where) == FAILURE)
goto error;

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
2009-08-17 Daniel Kraft <d@domob.eu>
PR fortran/37425
* gfortran.dg/typebound_operator_2.f03: Test for error with illegal
NOPASS bindings as operators.
2009-08-17 Uros Bizjak <ubizjak@gmail.com>
* lib/target-supports.exp

13
gcc/testsuite/gfortran.dg/typebound_operator_2.f03
View file

@ -13,8 +13,8 @@ MODULE m
PROCEDURE, PASS :: onearg
PROCEDURE, PASS :: onearg_alt => onearg
PROCEDURE, PASS :: onearg_alt2 => onearg
PROCEDURE, NOPASS :: nopassed => onearg
PROCEDURE, PASS :: threearg
PROCEDURE, NOPASS :: noarg
PROCEDURE, PASS :: sub
PROCEDURE, PASS :: sub2 ! { dg-error "must be a FUNCTION" }
PROCEDURE, PASS :: func
@ -26,10 +26,15 @@ MODULE m
GENERIC :: OPERATOR(.UOPA.) => sub ! { dg-error "must be a FUNCTION" }
GENERIC :: OPERATOR(.UOPB.) => threearg ! { dg-error "at most, two arguments" }
GENERIC :: OPERATOR(.UOPC.) => noarg ! { dg-error "at least one argument" }
! We can't check for the 'at least one argument' error, because in this case
! the procedure must be NOPASS and that other error is issued. But of
! course this should be alright.
GENERIC :: OPERATOR(.UNARY.) => onearg_alt
GENERIC, PRIVATE :: OPERATOR(.UNARY.) => onearg_alt2 ! { dg-error "must have the same access" }
GENERIC :: OPERATOR(.UNARYPRIME.) => nopassed ! { dg-error "can't be NOPASS" }
GENERIC :: OPERATOR(-) => nopassed ! { dg-error "can't be NOPASS" }
END TYPE t
CONTAINS
@ -44,10 +49,6 @@ CONTAINS
threearg = 42
END FUNCTION threearg
INTEGER FUNCTION noarg ()
noarg = 42
END FUNCTION noarg
LOGICAL FUNCTION func (me, b) ! { dg-error "must be a SUBROUTINE" }
CLASS(t), INTENT(OUT) :: me
CLASS(t), INTENT(IN) :: b