* [Patch, fortran] PR98498 - Interp request: defined operators and unlimited polymorphic
@ 2023-11-01 18:02 Paul Richard Thomas
2023-11-01 20:12 ` Harald Anlauf
0 siblings, 1 reply; 4+ messages in thread
From: Paul Richard Thomas @ 2023-11-01 18:02 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1.1: Type: text/plain, Size: 940 bytes --]
The interpretation request came in a long time ago but I only just got
around to implementing it.
The updated text from the standard is in the comment. Now I am writing
this, I think that I should perhaps use switch(op)/case rather than using
if/else if and depending on the order of the gfc_intrinsic_op enum being
maintained. Thoughts?
The testcase runs fine with both mainline and nagfor. I think that
compile-only with counts of star-eq and star_not should suffice.
Regtests with no regressions. OK for mainline?
Paul
Fortran: Defined operators with unlimited polymorphic args [PR98498]
2023-11-01 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/98498
* interface.cc (upoly_ok): New function.
(gfc_extend_expr): Use new function to ensure that defined
operators using unlimited polymorphic formal arguments do not
override their intrinsic uses.
gcc/testsuite/
PR fortran/98498
* gfortran.dg/interface_50.f90: New test.
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 2384 bytes --]
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 8c4571e0aa6..ba7fb5dfea5 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -4616,6 +4616,35 @@ build_compcall_for_operator (gfc_expr* e, gfc_actual_arglist* actual,
}
+/* Check if the type of an actual argument is OK to use with an
+ unlimited polymorphic formal argument in a defined operation. */
+
+static bool
+upoly_ok (bt type, gfc_intrinsic_op op)
+{
+ bool ok = false;
+ if (type == BT_DERIVED || type == BT_CLASS)
+ ok = true;
+ else if ((op >= INTRINSIC_UPLUS && op <= INTRINSIC_POWER)
+ && (type == BT_LOGICAL || type == BT_CHARACTER))
+ ok = true;
+ else if ((op == INTRINSIC_CONCAT) && (type != BT_CHARACTER))
+ ok = true;
+ else if ((op >= INTRINSIC_GT && op <= INTRINSIC_LE)
+ && (type == BT_COMPLEX))
+ ok = true;
+ else if ((op >= INTRINSIC_GT_OS) && (op <= INTRINSIC_LE_OS)
+ && (type == BT_COMPLEX))
+ ok = true;
+ else if ((op >= INTRINSIC_AND) && (op <= INTRINSIC_NEQV)
+ && (type != BT_LOGICAL))
+ ok = true;
+ else if ((op == INTRINSIC_NOT) && (type != BT_LOGICAL))
+ ok = true;
+ return ok;
+}
+
+
/* This subroutine is called when an expression is being resolved.
The expression node in question is either a user defined operator
or an intrinsic operator with arguments that aren't compatible
@@ -4737,6 +4766,24 @@ gfc_extend_expr (gfc_expr *e)
if (sym != NULL)
break;
}
+
+ /* F2018(15.4.3.4.2): "If the operator is an intrinsic-operator (R608),
+ the number of dummy arguments shall be consistent with the intrinsic
+ uses of that operator, and the types, kind type parameters, or ranks
+ of the dummy arguments shall differ from those required for the
+ intrinsic operation (10.1.5)." ie. the use of unlimited polymorphic
+ formal arguments must not override the intrinsic uses. */
+ if (sym && (UNLIMITED_POLY (sym->formal->sym)
+ || (sym->formal->next
+ && UNLIMITED_POLY (sym->formal->next->sym))))
+ {
+ bool arg2 = (actual->next != NULL);
+ bool a1ok = upoly_ok (actual->expr->ts.type, e->value.op.op);
+ bool a2ok = arg2 && upoly_ok (actual->next->expr->ts.type,
+ e->value.op.op);
+ if ((!arg2 && !a1ok) || (arg2 && (!a1ok && !a2ok)))
+ sym = NULL;
+ }
}
/* TODO: Do an ambiguity-check and error if multiple matching interfaces are
[-- Attachment #3: interface_50.f90 --]
[-- Type: text/x-fortran, Size: 2419 bytes --]
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! Tests the fix for PR98498, which was subject to an interpretation request
! as to whether or not the interface operator overrode the intrinsic use.
! (See PR for correspondence)
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
MODULE mytypes
IMPLICIT none
TYPE pvar
character(len=20) :: name
integer :: level
end TYPE pvar
interface operator (==)
module procedure star_eq
end interface
interface operator (.not.)
module procedure star_not
end interface
contains
function star_eq(a, b)
implicit none
class(*), intent(in) :: a, b
logical :: star_eq
select type (a)
type is (pvar)
select type (b)
type is (pvar)
if((a%level .eq. b%level) .and. (a%name .eq. b%name)) then
star_eq = .true.
else
star_eq = .false.
end if
type is (integer)
star_eq = (a%level == b)
end select
class default
star_eq = .false.
end select
end function star_eq
function star_not (a)
implicit none
class(*), intent(in) :: a
type(pvar) :: star_not
select type (a)
type is (pvar)
star_not = a
star_not%level = -star_not%level
type is (real)
star_not = pvar ("real", -int(a))
class default
star_not = pvar ("noname", 0)
end select
end function
end MODULE mytypes
program test_eq
use mytypes
implicit none
type(pvar) x, y
integer :: i = 4
real :: r = 2.0
! Check that intrinsic use of .not. and == is not overridden.
if (.not.(i == 2*int (r))) stop 1
if (r == 1.0) stop 2
! Test defined operator ==
x = pvar('test 1', 100)
y = pvar('test 1', 100)
if (.not.(x == y)) stop 3
y = pvar('test 2', 100)
if (x == y) stop 4
if (x == r) stop 5 ! class default gives .false.
if (100 == x) stop 6 ! ditto
if (.not.(x == 100)) stop 7 ! integer selector gives a%level == b
! Test defined operator .not.
y = .not.x
if (y%level .ne. -x%level) stop 11
y = .not.i
if (y%level .ne. 0 .and. trim(y%name) .ne. "noname") stop 12
y = .not.r
if (y%level .ne. -2 .and. trim(y%name) .ne. "real") stop 13
end program test_eq
! { dg-final { scan-tree-dump-times "star_eq" 12 "original" } }
! { dg-final { scan-tree-dump-times "star_not" 11 "original" } }
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] PR98498 - Interp request: defined operators and unlimited polymorphic
2023-11-01 18:02 [Patch, fortran] PR98498 - Interp request: defined operators and unlimited polymorphic Paul Richard Thomas
@ 2023-11-01 20:12 ` Harald Anlauf
2023-11-02 18:18 ` Paul Richard Thomas
0 siblings, 1 reply; 4+ messages in thread
From: Harald Anlauf @ 2023-11-01 20:12 UTC (permalink / raw)
To: Paul Richard Thomas, fortran, gcc-patches
Hi Paul,
Am 01.11.23 um 19:02 schrieb Paul Richard Thomas:
> The interpretation request came in a long time ago but I only just got
> around to implementing it.
>
> The updated text from the standard is in the comment. Now I am writing
> this, I think that I should perhaps use switch(op)/case rather than using
> if/else if and depending on the order of the gfc_intrinsic_op enum being
> maintained. Thoughts?
the logic is likely harder to parse with if/else than with
switch(op)/case. However, I do not think that the order of
the enum will ever be changed, as the module format relies
on that very order.
> The testcase runs fine with both mainline and nagfor. I think that
> compile-only with counts of star-eq and star_not should suffice.
I found other cases that are rejected even with your patch,
but which are accepted by nagfor. Example:
print *, ('a' == c)
Nagfor prints F at runtime as expected, as it correctly resolves
this to star_eq. Further examples can be easily constructed.
Can you have a look?
Thanks,
Harald
> Regtests with no regressions. OK for mainline?
>
> Paul
>
> Fortran: Defined operators with unlimited polymorphic args [PR98498]
>
> 2023-11-01 Paul Thomas <pault@gcc.gnu.org>
>
> gcc/fortran
> PR fortran/98498
> * interface.cc (upoly_ok): New function.
> (gfc_extend_expr): Use new function to ensure that defined
> operators using unlimited polymorphic formal arguments do not
> override their intrinsic uses.
>
> gcc/testsuite/
> PR fortran/98498
> * gfortran.dg/interface_50.f90: New test.
>
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] PR98498 - Interp request: defined operators and unlimited polymorphic
2023-11-01 20:12 ` Harald Anlauf
@ 2023-11-02 18:18 ` Paul Richard Thomas
2023-11-02 20:35 ` Harald Anlauf
0 siblings, 1 reply; 4+ messages in thread
From: Paul Richard Thomas @ 2023-11-02 18:18 UTC (permalink / raw)
To: Harald Anlauf; +Cc: fortran, gcc-patches
[-- Attachment #1.1: Type: text/plain, Size: 2361 bytes --]
Hi Harald,
I was overthinking the problem. The rejected cases led me to a fix that can
only be described as a considerable simplification compared with the first
patch!
The testcase now reflects the requirements of the standard and
regtests without failures.
OK for mainline?
Thanks
Paul
Fortran: Defined operators with unlimited polymorphic args [PR98498]
2023-11-02 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/98498
* interface.cc (upoly_ok): Defined operators using unlimited
polymorphic formal arguments must not override the intrinsic
operator use.
gcc/testsuite/
PR fortran/98498
* gfortran.dg/interface_50.f90: New test.
On Wed, 1 Nov 2023 at 20:12, Harald Anlauf <anlauf@gmx.de> wrote:
> Hi Paul,
>
> Am 01.11.23 um 19:02 schrieb Paul Richard Thomas:
> > The interpretation request came in a long time ago but I only just got
> > around to implementing it.
> >
> > The updated text from the standard is in the comment. Now I am writing
> > this, I think that I should perhaps use switch(op)/case rather than using
> > if/else if and depending on the order of the gfc_intrinsic_op enum being
> > maintained. Thoughts?
>
> the logic is likely harder to parse with if/else than with
> switch(op)/case. However, I do not think that the order of
> the enum will ever be changed, as the module format relies
> on that very order.
>
> > The testcase runs fine with both mainline and nagfor. I think that
> > compile-only with counts of star-eq and star_not should suffice.
>
> I found other cases that are rejected even with your patch,
> but which are accepted by nagfor. Example:
>
> print *, ('a' == c)
>
> Nagfor prints F at runtime as expected, as it correctly resolves
> this to star_eq. Further examples can be easily constructed.
>
> Can you have a look?
>
> Thanks,
> Harald
>
> > Regtests with no regressions. OK for mainline?
> >
> > Paul
> >
> > Fortran: Defined operators with unlimited polymorphic args [PR98498]
> >
> > 2023-11-01 Paul Thomas <pault@gcc.gnu.org>
> >
> > gcc/fortran
> > PR fortran/98498
> > * interface.cc (upoly_ok): New function.
> > (gfc_extend_expr): Use new function to ensure that defined
> > operators using unlimited polymorphic formal arguments do not
> > override their intrinsic uses.
> >
> > gcc/testsuite/
> > PR fortran/98498
> > * gfortran.dg/interface_50.f90: New test.
> >
>
>
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 776 bytes --]
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 8c4571e0aa6..fc4fe662eab 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -4737,6 +4737,17 @@ gfc_extend_expr (gfc_expr *e)
if (sym != NULL)
break;
}
+
+ /* F2018(15.4.3.4.2) requires that the use of unlimited polymorphic
+ formal arguments does not override the intrinsic uses. */
+ gfc_push_suppress_errors ();
+ if (sym
+ && (UNLIMITED_POLY (sym->formal->sym)
+ || (sym->formal->next
+ && UNLIMITED_POLY (sym->formal->next->sym)))
+ && !gfc_check_operator_interface (sym, e->value.op.op, e->where))
+ sym = NULL;
+ gfc_pop_suppress_errors ();
}
/* TODO: Do an ambiguity-check and error if multiple matching interfaces are
[-- Attachment #3: interface_50.f90 --]
[-- Type: text/x-fortran, Size: 2596 bytes --]
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! Tests the fix for PR98498, which was subject to an interpretation request
! as to whether or not the interface operator overrode the intrinsic use.
! (See PR for correspondence)
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
MODULE mytypes
IMPLICIT none
TYPE pvar
character(len=20) :: name
integer :: level
end TYPE pvar
interface operator (==)
module procedure star_eq
end interface
interface operator (.not.)
module procedure star_not
end interface
contains
function star_eq(a, b)
implicit none
class(*), intent(in) :: a, b
logical :: star_eq
select type (a)
type is (pvar)
select type (b)
type is (pvar)
if((a%level .eq. b%level) .and. (a%name .eq. b%name)) then
star_eq = .true.
else
star_eq = .false.
end if
type is (integer)
star_eq = (a%level == b)
end select
class default
star_eq = .false.
end select
end function star_eq
function star_not (a)
implicit none
class(*), intent(in) :: a
type(pvar) :: star_not
select type (a)
type is (pvar)
star_not = a
star_not%level = -star_not%level
type is (real)
star_not = pvar ("real", -int(a))
class default
star_not = pvar ("noname", 0)
end select
end function
end MODULE mytypes
program test_eq
use mytypes
implicit none
type(pvar) x, y
integer :: i = 4
real :: r = 2.0
character(len = 4, kind =4) :: c = "abcd"
! Check that intrinsic use of .not. and == is not overridden.
if (.not.(i == 2*int (r))) stop 1
if (r == 1.0) stop 2
! Test defined operator ==
x = pvar('test 1', 100)
y = pvar('test 1', 100)
if (.not.(x == y)) stop 3
y = pvar('test 2', 100)
if (x == y) stop 4
if (x == r) stop 5 ! class default gives .false.
if (100 == x) stop 6 ! ditto
if (.not.(x == 100)) stop 7 ! integer selector gives a%level == b
if (i == "c") stop 8 ! type mismatch => calls star_eq
if (c == "abcd") stop 9 ! kind mismatch => calls star_eq
! Test defined operator .not.
y = .not.x
if (y%level .ne. -x%level) stop 11
y = .not.i
if (y%level .ne. 0 .and. trim(y%name) .ne. "noname") stop 12
y = .not.r
if (y%level .ne. -2 .and. trim(y%name) .ne. "real") stop 13
end program test_eq
! { dg-final { scan-tree-dump-times "star_eq" 14 "original" } }
! { dg-final { scan-tree-dump-times "star_not" 11 "original" } }
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] PR98498 - Interp request: defined operators and unlimited polymorphic
2023-11-02 18:18 ` Paul Richard Thomas
@ 2023-11-02 20:35 ` Harald Anlauf
0 siblings, 0 replies; 4+ messages in thread
From: Harald Anlauf @ 2023-11-02 20:35 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: fortran, gcc-patches
Hi Paul,
Am 02.11.23 um 19:18 schrieb Paul Richard Thomas:
> Hi Harald,
>
> I was overthinking the problem. The rejected cases led me to a fix that can
> only be described as a considerable simplification compared with the first
> patch!
this patch is *much* simpler, makes more sense, and works here. :-)
> The testcase now reflects the requirements of the standard and
> regtests without failures.
>
> OK for mainline?
Yes, OK for mainline.
Thanks,
Harald
> Thanks
>
> Paul
>
> Fortran: Defined operators with unlimited polymorphic args [PR98498]
>
> 2023-11-02 Paul Thomas <pault@gcc.gnu.org>
>
> gcc/fortran
> PR fortran/98498
> * interface.cc (upoly_ok): Defined operators using unlimited
> polymorphic formal arguments must not override the intrinsic
> operator use.
>
> gcc/testsuite/
> PR fortran/98498
> * gfortran.dg/interface_50.f90: New test.
>
>
> On Wed, 1 Nov 2023 at 20:12, Harald Anlauf <anlauf@gmx.de> wrote:
>
>> Hi Paul,
>>
>> Am 01.11.23 um 19:02 schrieb Paul Richard Thomas:
>>> The interpretation request came in a long time ago but I only just got
>>> around to implementing it.
>>>
>>> The updated text from the standard is in the comment. Now I am writing
>>> this, I think that I should perhaps use switch(op)/case rather than using
>>> if/else if and depending on the order of the gfc_intrinsic_op enum being
>>> maintained. Thoughts?
>>
>> the logic is likely harder to parse with if/else than with
>> switch(op)/case. However, I do not think that the order of
>> the enum will ever be changed, as the module format relies
>> on that very order.
>>
>>> The testcase runs fine with both mainline and nagfor. I think that
>>> compile-only with counts of star-eq and star_not should suffice.
>>
>> I found other cases that are rejected even with your patch,
>> but which are accepted by nagfor. Example:
>>
>> print *, ('a' == c)
>>
>> Nagfor prints F at runtime as expected, as it correctly resolves
>> this to star_eq. Further examples can be easily constructed.
>>
>> Can you have a look?
>>
>> Thanks,
>> Harald
>>
>>> Regtests with no regressions. OK for mainline?
>>>
>>> Paul
>>>
>>> Fortran: Defined operators with unlimited polymorphic args [PR98498]
>>>
>>> 2023-11-01 Paul Thomas <pault@gcc.gnu.org>
>>>
>>> gcc/fortran
>>> PR fortran/98498
>>> * interface.cc (upoly_ok): New function.
>>> (gfc_extend_expr): Use new function to ensure that defined
>>> operators using unlimited polymorphic formal arguments do not
>>> override their intrinsic uses.
>>>
>>> gcc/testsuite/
>>> PR fortran/98498
>>> * gfortran.dg/interface_50.f90: New test.
>>>
>>
>>
>
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2023-11-02 20:35 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-11-01 18:02 [Patch, fortran] PR98498 - Interp request: defined operators and unlimited polymorphic Paul Richard Thomas
2023-11-01 20:12 ` Harald Anlauf
2023-11-02 18:18 ` Paul Richard Thomas
2023-11-02 20:35 ` Harald Anlauf
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).