re PR fortran/41951 ([OOP] Not diagnosing ambiguous operators (TB vs. INTERFACE))
2012-06-27 Janus Weil <janus@gcc.gnu.org> PR fortran/41951 PR fortran/49591 * interface.c (check_new_interface): Rename, add 'loc' argument, make non-static. (gfc_add_interface): Rename 'check_new_interface' * gfortran.h (gfc_check_new_interface): Add prototype. * resolve.c (resolve_typebound_intrinsic_op): Add typebound operator targets to non-typebound operator list. 2012-06-27 Janus Weil <janus@gcc.gnu.org> PR fortran/41951 PR fortran/49591 * gfortran.dg/typebound_operator_16.f03: New. From-SVN: r189022
This commit is contained in:
parent
b585a51fb9
commit
362aa47460
|
@ -1,3 +1,14 @@
|
||||||
|
2012-06-27 Janus Weil <janus@gcc.gnu.org>
|
||||||
|
|
||||||
|
PR fortran/41951
|
||||||
|
PR fortran/49591
|
||||||
|
* interface.c (check_new_interface): Rename, add 'loc' argument,
|
||||||
|
make non-static.
|
||||||
|
(gfc_add_interface): Rename 'check_new_interface'
|
||||||
|
* gfortran.h (gfc_check_new_interface): Add prototype.
|
||||||
|
* resolve.c (resolve_typebound_intrinsic_op): Add typebound operator
|
||||||
|
targets to non-typebound operator list.
|
||||||
|
|
||||||
2012-06-22 Janus Weil <janus@gcc.gnu.org>
|
2012-06-22 Janus Weil <janus@gcc.gnu.org>
|
||||||
|
|
||||||
PR fortran/47710
|
PR fortran/47710
|
||||||
|
|
|
@ -2851,6 +2851,7 @@ gfc_symbol *gfc_search_interface (gfc_interface *, int,
|
||||||
match gfc_extend_expr (gfc_expr *);
|
match gfc_extend_expr (gfc_expr *);
|
||||||
void gfc_free_formal_arglist (gfc_formal_arglist *);
|
void gfc_free_formal_arglist (gfc_formal_arglist *);
|
||||||
gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *);
|
gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *);
|
||||||
|
gfc_try gfc_check_new_interface (gfc_interface *, gfc_symbol *, locus);
|
||||||
gfc_try gfc_add_interface (gfc_symbol *);
|
gfc_try gfc_add_interface (gfc_symbol *);
|
||||||
gfc_interface *gfc_current_interface_head (void);
|
gfc_interface *gfc_current_interface_head (void);
|
||||||
void gfc_set_current_interface_head (gfc_interface *);
|
void gfc_set_current_interface_head (gfc_interface *);
|
||||||
|
|
|
@ -3551,8 +3551,8 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
|
||||||
the given interface list. Ambiguity isn't checked yet since module
|
the given interface list. Ambiguity isn't checked yet since module
|
||||||
procedures can be present without interfaces. */
|
procedures can be present without interfaces. */
|
||||||
|
|
||||||
static gfc_try
|
gfc_try
|
||||||
check_new_interface (gfc_interface *base, gfc_symbol *new_sym)
|
gfc_check_new_interface (gfc_interface *base, gfc_symbol *new_sym, locus loc)
|
||||||
{
|
{
|
||||||
gfc_interface *ip;
|
gfc_interface *ip;
|
||||||
|
|
||||||
|
@ -3560,8 +3560,8 @@ check_new_interface (gfc_interface *base, gfc_symbol *new_sym)
|
||||||
{
|
{
|
||||||
if (ip->sym == new_sym)
|
if (ip->sym == new_sym)
|
||||||
{
|
{
|
||||||
gfc_error ("Entity '%s' at %C is already present in the interface",
|
gfc_error ("Entity '%s' at %L is already present in the interface",
|
||||||
new_sym->name);
|
new_sym->name, &loc);
|
||||||
return FAILURE;
|
return FAILURE;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -3591,48 +3591,61 @@ gfc_add_interface (gfc_symbol *new_sym)
|
||||||
{
|
{
|
||||||
case INTRINSIC_EQ:
|
case INTRINSIC_EQ:
|
||||||
case INTRINSIC_EQ_OS:
|
case INTRINSIC_EQ_OS:
|
||||||
if (check_new_interface (ns->op[INTRINSIC_EQ], new_sym) == FAILURE ||
|
if (gfc_check_new_interface (ns->op[INTRINSIC_EQ], new_sym,
|
||||||
check_new_interface (ns->op[INTRINSIC_EQ_OS], new_sym) == FAILURE)
|
gfc_current_locus) == FAILURE
|
||||||
|
|| gfc_check_new_interface (ns->op[INTRINSIC_EQ_OS], new_sym,
|
||||||
|
gfc_current_locus) == FAILURE)
|
||||||
return FAILURE;
|
return FAILURE;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case INTRINSIC_NE:
|
case INTRINSIC_NE:
|
||||||
case INTRINSIC_NE_OS:
|
case INTRINSIC_NE_OS:
|
||||||
if (check_new_interface (ns->op[INTRINSIC_NE], new_sym) == FAILURE ||
|
if (gfc_check_new_interface (ns->op[INTRINSIC_NE], new_sym,
|
||||||
check_new_interface (ns->op[INTRINSIC_NE_OS], new_sym) == FAILURE)
|
gfc_current_locus) == FAILURE
|
||||||
|
|| gfc_check_new_interface (ns->op[INTRINSIC_NE_OS], new_sym,
|
||||||
|
gfc_current_locus) == FAILURE)
|
||||||
return FAILURE;
|
return FAILURE;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case INTRINSIC_GT:
|
case INTRINSIC_GT:
|
||||||
case INTRINSIC_GT_OS:
|
case INTRINSIC_GT_OS:
|
||||||
if (check_new_interface (ns->op[INTRINSIC_GT], new_sym) == FAILURE ||
|
if (gfc_check_new_interface (ns->op[INTRINSIC_GT], new_sym,
|
||||||
check_new_interface (ns->op[INTRINSIC_GT_OS], new_sym) == FAILURE)
|
gfc_current_locus) == FAILURE
|
||||||
|
|| gfc_check_new_interface (ns->op[INTRINSIC_GT_OS], new_sym,
|
||||||
|
gfc_current_locus) == FAILURE)
|
||||||
return FAILURE;
|
return FAILURE;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case INTRINSIC_GE:
|
case INTRINSIC_GE:
|
||||||
case INTRINSIC_GE_OS:
|
case INTRINSIC_GE_OS:
|
||||||
if (check_new_interface (ns->op[INTRINSIC_GE], new_sym) == FAILURE ||
|
if (gfc_check_new_interface (ns->op[INTRINSIC_GE], new_sym,
|
||||||
check_new_interface (ns->op[INTRINSIC_GE_OS], new_sym) == FAILURE)
|
gfc_current_locus) == FAILURE
|
||||||
|
|| gfc_check_new_interface (ns->op[INTRINSIC_GE_OS], new_sym,
|
||||||
|
gfc_current_locus) == FAILURE)
|
||||||
return FAILURE;
|
return FAILURE;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case INTRINSIC_LT:
|
case INTRINSIC_LT:
|
||||||
case INTRINSIC_LT_OS:
|
case INTRINSIC_LT_OS:
|
||||||
if (check_new_interface (ns->op[INTRINSIC_LT], new_sym) == FAILURE ||
|
if (gfc_check_new_interface (ns->op[INTRINSIC_LT], new_sym,
|
||||||
check_new_interface (ns->op[INTRINSIC_LT_OS], new_sym) == FAILURE)
|
gfc_current_locus) == FAILURE
|
||||||
|
|| gfc_check_new_interface (ns->op[INTRINSIC_LT_OS], new_sym,
|
||||||
|
gfc_current_locus) == FAILURE)
|
||||||
return FAILURE;
|
return FAILURE;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case INTRINSIC_LE:
|
case INTRINSIC_LE:
|
||||||
case INTRINSIC_LE_OS:
|
case INTRINSIC_LE_OS:
|
||||||
if (check_new_interface (ns->op[INTRINSIC_LE], new_sym) == FAILURE ||
|
if (gfc_check_new_interface (ns->op[INTRINSIC_LE], new_sym,
|
||||||
check_new_interface (ns->op[INTRINSIC_LE_OS], new_sym) == FAILURE)
|
gfc_current_locus) == FAILURE
|
||||||
|
|| gfc_check_new_interface (ns->op[INTRINSIC_LE_OS], new_sym,
|
||||||
|
gfc_current_locus) == FAILURE)
|
||||||
return FAILURE;
|
return FAILURE;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
default:
|
default:
|
||||||
if (check_new_interface (ns->op[current_interface.op], new_sym) == FAILURE)
|
if (gfc_check_new_interface (ns->op[current_interface.op], new_sym,
|
||||||
|
gfc_current_locus) == FAILURE)
|
||||||
return FAILURE;
|
return FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -3646,7 +3659,8 @@ gfc_add_interface (gfc_symbol *new_sym)
|
||||||
if (sym == NULL)
|
if (sym == NULL)
|
||||||
continue;
|
continue;
|
||||||
|
|
||||||
if (check_new_interface (sym->generic, new_sym) == FAILURE)
|
if (gfc_check_new_interface (sym->generic, new_sym, gfc_current_locus)
|
||||||
|
== FAILURE)
|
||||||
return FAILURE;
|
return FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -3654,8 +3668,8 @@ gfc_add_interface (gfc_symbol *new_sym)
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case INTERFACE_USER_OP:
|
case INTERFACE_USER_OP:
|
||||||
if (check_new_interface (current_interface.uop->op, new_sym)
|
if (gfc_check_new_interface (current_interface.uop->op, new_sym,
|
||||||
== FAILURE)
|
gfc_current_locus) == FAILURE)
|
||||||
return FAILURE;
|
return FAILURE;
|
||||||
|
|
||||||
head = ¤t_interface.uop->op;
|
head = ¤t_interface.uop->op;
|
||||||
|
|
|
@ -11264,6 +11264,22 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op,
|
||||||
|
|
||||||
if (!gfc_check_operator_interface (target_proc, op, p->where))
|
if (!gfc_check_operator_interface (target_proc, op, p->where))
|
||||||
goto error;
|
goto error;
|
||||||
|
|
||||||
|
/* Add target to non-typebound operator list. */
|
||||||
|
if (!target->specific->deferred && !derived->attr.use_assoc
|
||||||
|
&& p->access != ACCESS_PRIVATE)
|
||||||
|
{
|
||||||
|
gfc_interface *head, *intr;
|
||||||
|
if (gfc_check_new_interface (derived->ns->op[op], target_proc,
|
||||||
|
p->where) == FAILURE)
|
||||||
|
return FAILURE;
|
||||||
|
head = derived->ns->op[op];
|
||||||
|
intr = gfc_get_interface ();
|
||||||
|
intr->sym = target_proc;
|
||||||
|
intr->where = p->where;
|
||||||
|
intr->next = head;
|
||||||
|
derived->ns->op[op] = intr;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return SUCCESS;
|
return SUCCESS;
|
||||||
|
|
|
@ -1,3 +1,9 @@
|
||||||
|
2012-06-27 Janus Weil <janus@gcc.gnu.org>
|
||||||
|
|
||||||
|
PR fortran/41951
|
||||||
|
PR fortran/49591
|
||||||
|
* gfortran.dg/typebound_operator_16.f03: New.
|
||||||
|
|
||||||
2012-06-27 Jakub Jelinek <jakub@redhat.com>
|
2012-06-27 Jakub Jelinek <jakub@redhat.com>
|
||||||
|
|
||||||
* gcc.target/i386/sse4_1-pmuldq.c (TEST): Initialize
|
* gcc.target/i386/sse4_1-pmuldq.c (TEST): Initialize
|
||||||
|
|
|
@ -0,0 +1,49 @@
|
||||||
|
! { dg-do compile }
|
||||||
|
!
|
||||||
|
! PR 49591: [OOP] Multiple identical specific procedures in type-bound operator not detected
|
||||||
|
!
|
||||||
|
! This is interpretation request F03/0018:
|
||||||
|
! http://www.j3-fortran.org/doc/meeting/195/11-214.txt
|
||||||
|
!
|
||||||
|
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
|
||||||
|
|
||||||
|
module M1
|
||||||
|
type T
|
||||||
|
integer x
|
||||||
|
contains
|
||||||
|
procedure :: MyAdd_t => myadd
|
||||||
|
generic :: operator(+) => myAdd_t
|
||||||
|
end type T
|
||||||
|
type X
|
||||||
|
real q
|
||||||
|
contains
|
||||||
|
procedure, pass(b) :: MyAdd_x => myadd
|
||||||
|
generic :: operator(+) => myAdd_x ! { dg-error "is already present in the interface" }
|
||||||
|
end type X
|
||||||
|
contains
|
||||||
|
integer function MyAdd ( A, B )
|
||||||
|
class(t), intent(in) :: A
|
||||||
|
class(x), intent(in) :: B
|
||||||
|
myadd = a%x + b%q
|
||||||
|
end function MyAdd
|
||||||
|
end module
|
||||||
|
|
||||||
|
module M2
|
||||||
|
interface operator(+)
|
||||||
|
procedure MyAdd
|
||||||
|
end interface
|
||||||
|
type T
|
||||||
|
integer x
|
||||||
|
contains
|
||||||
|
procedure :: MyAdd_t => myadd
|
||||||
|
generic :: operator(+) => myAdd_t ! { dg-error "is already present in the interface" }
|
||||||
|
end type T
|
||||||
|
contains
|
||||||
|
integer function MyAdd ( A, B )
|
||||||
|
class(t), intent(in) :: A
|
||||||
|
real, intent(in) :: B
|
||||||
|
myadd = a%x + b
|
||||||
|
end function MyAdd
|
||||||
|
end module
|
||||||
|
|
||||||
|
! { dg-final { cleanup-modules "M1 M2" } }
|
Loading…
Reference in New Issue