mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 08:00:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/45786 (Relational operators .eq. and == are not recognized as equivalent)

Browse Source 
2011-05-29  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/45786
	* interface.c (gfc_equivalent_op):  New function.
	(gfc_check_interface):  Use gfc_equivalent_op instead
	of switch statement.
	* decl.c (access_attr_decl):  Also set access to an
	equivalent operator.

2011-05-29  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/45786
	* gfortran.dg/operator_7.f90:  New test case.

From-SVN: r174412
This commit is contained in:
Thomas Koenig 2011-05-29 18:41:00 +00:00
parent 427180d243
commit fb03a37e57
4 changed files with 96 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/decl.c
View File

@ -6478,8 +6478,19 @@ access_attr_decl (gfc_statement st)
case INTERFACE_INTRINSIC_OP:
if (gfc_current_ns->operator_access[op] == ACCESS_UNKNOWN)
{
gfc_intrinsic_op other_op;
gfc_current_ns->operator_access[op] =
(st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
/* Handle the case if there is another op with the same
function, for INTRINSIC_EQ vs. INTRINSIC_EQ_OS and so on. */
other_op = gfc_equivalent_op (op);
if (other_op != INTRINSIC_NONE)
gfc_current_ns->operator_access[other_op] =
(st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
}
else
{

1
gcc/fortran/gfortran.h
View File

@ -2816,6 +2816,7 @@ gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
int gfc_has_vector_subscript (gfc_expr*);
gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
/* io.c */
extern gfc_st_label format_asterisk;

122
gcc/fortran/interface.c
View File

@ -1264,6 +1264,54 @@ check_uop_interfaces (gfc_user_op *uop)
}
}
/* Given an intrinsic op, return an equivalent op if one exists,
or INTRINSIC_NONE otherwise. */
gfc_intrinsic_op
gfc_equivalent_op (gfc_intrinsic_op op)
{
switch(op)
{
case INTRINSIC_EQ:
return INTRINSIC_EQ_OS;
case INTRINSIC_EQ_OS:
return INTRINSIC_EQ;
case INTRINSIC_NE:
return INTRINSIC_NE_OS;
case INTRINSIC_NE_OS:
return INTRINSIC_NE;
case INTRINSIC_GT:
return INTRINSIC_GT_OS;
case INTRINSIC_GT_OS:
return INTRINSIC_GT;
case INTRINSIC_GE:
return INTRINSIC_GE_OS;
case INTRINSIC_GE_OS:
return INTRINSIC_GE;
case INTRINSIC_LT:
return INTRINSIC_LT_OS;
case INTRINSIC_LT_OS:
return INTRINSIC_LT;
case INTRINSIC_LE:
return INTRINSIC_LE_OS;
case INTRINSIC_LE_OS:
return INTRINSIC_LE;
default:
return INTRINSIC_NONE;
}
}
/* For the namespace, check generic, user operator and intrinsic
operator interfaces for consistency and to remove duplicate
@ -1304,75 +1352,19 @@ gfc_check_interfaces (gfc_namespace *ns)
for (ns2 = ns; ns2; ns2 = ns2->parent)
{
gfc_intrinsic_op other_op;
if (check_interface1 (ns->op[i], ns2->op[i], 0,
interface_name, true))
goto done;
switch (i)
{
case INTRINSIC_EQ:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_EQ_OS],
0, interface_name, true)) goto done;
break;
case INTRINSIC_EQ_OS:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_EQ],
0, interface_name, true)) goto done;
break;
case INTRINSIC_NE:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_NE_OS],
0, interface_name, true)) goto done;
break;
case INTRINSIC_NE_OS:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_NE],
0, interface_name, true)) goto done;
break;
case INTRINSIC_GT:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GT_OS],
0, interface_name, true)) goto done;
break;
case INTRINSIC_GT_OS:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GT],
0, interface_name, true)) goto done;
break;
case INTRINSIC_GE:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GE_OS],
0, interface_name, true)) goto done;
break;
case INTRINSIC_GE_OS:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_GE],
0, interface_name, true)) goto done;
break;
case INTRINSIC_LT:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LT_OS],
0, interface_name, true)) goto done;
break;
case INTRINSIC_LT_OS:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LT],
0, interface_name, true)) goto done;
break;
case INTRINSIC_LE:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LE_OS],
0, interface_name, true)) goto done;
break;
case INTRINSIC_LE_OS:
if (check_interface1 (ns->op[i], ns2->op[INTRINSIC_LE],
0, interface_name, true)) goto done;
break;
default:
break;
}
/* i should be gfc_intrinsic_op, but has to be int with this cast
here for stupid C++ compatibility rules. */
other_op = gfc_equivalent_op ((gfc_intrinsic_op) i);
if (other_op != INTRINSIC_NONE
&& check_interface1 (ns->op[i], ns2->op[other_op],
0, interface_name, true))
goto done;
}
}

27
gcc/testsuite/gfortran.dg/operator_7.f90 Normal file
View File

@ -0,0 +1,27 @@
! { dg-do compile }
! PR fortran/45786 - operators were not correctly marked as public
! if the alternative form was used.
! Test case contributed by Neil Carlson.
module foo_type
private
public :: foo, operator(==)
type :: foo
integer :: bar
end type
interface operator(.eq.)
module procedure eq_foo
end interface
contains
logical function eq_foo (a, b)
type(foo), intent(in) :: a, b
eq_foo = (a%bar == b%bar)
end function
end module
subroutine use_it (a, b)
use foo_type
type(foo) :: a, b
print *, a == b
end subroutine
! { dg-final { cleanup-modules "foo_type" } }