From: Daniel Kraft Date: Mon, 17 Aug 2009 18:55:30 +0000 (+0200) Subject: re PR fortran/37425 (Fortran 2003: GENERIC bindings as operators) X-Git-Tag: releases/gcc-4.5.0~3962 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b325faf9d99e6d49917c5929a864534629c56892;p=thirdparty%2Fgcc.git re PR fortran/37425 (Fortran 2003: GENERIC bindings as operators) 2009-08-17 Daniel Kraft 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 PR fortran/37425 * gfortran.dg/typebound_operator_2.f03: Test for error with illegal NOPASS bindings as operators. From-SVN: r150856 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3abd3bbed315..10f95fb0cdfa 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2009-08-17 Daniel Kraft + + 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 PR fortran/41075 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fb72b938bee1..4f99aba07087 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c8713f5b0c57..7c905d7ad461 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2009-08-17 Daniel Kraft + + PR fortran/37425 + * gfortran.dg/typebound_operator_2.f03: Test for error with illegal + NOPASS bindings as operators. + 2009-08-17 Uros Bizjak * lib/target-supports.exp diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_2.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_2.f03 index ccce3b525c28..67f467cf9b82 100644 --- a/gcc/testsuite/gfortran.dg/typebound_operator_2.f03 +++ b/gcc/testsuite/gfortran.dg/typebound_operator_2.f03 @@ -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