On Sun, Jun 22, 2025 at 10:23 PM Mikael Morin <morin-mik...@orange.fr> wrote:
>
> From: Mikael Morin <mik...@gcc.gnu.org>
>
> See the description in the ChangeLog entry below.
>
> The testcases are best effort; for some operators the fortran frontend
> generates a temporary variable, so the simplification doesn't happen.
> Those cases are not tested.
>
> Regression tested on x86_64-linux. OK for master?
>
> -- 8< --
>
> gcc/ChangeLog:
>
> * match.pd (`op (non_lvalue X)`, `op (non_lvalue X) Y`,
> `op X (non_lvalue Y)`): New GENERIC simplifications, unwrap
> NON_LVALUE_EXPR expressions when they are used as operand of a
> unary or binary operator.
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/non_lvalue_2.f90: New test.
> * gfortran.dg/non_lvalue_3.f90: New test.
> ---
> gcc/match.pd | 19 +++
> gcc/testsuite/gfortran.dg/non_lvalue_2.f90 | 58 +++++++
> gcc/testsuite/gfortran.dg/non_lvalue_3.f90 | 172 +++++++++++++++++++++
> 3 files changed, 249 insertions(+)
> create mode 100644 gcc/testsuite/gfortran.dg/non_lvalue_2.f90
> create mode 100644 gcc/testsuite/gfortran.dg/non_lvalue_3.f90
>
> diff --git a/gcc/match.pd b/gcc/match.pd
> index 372d4657baa..53eb9f4d036 100644
> --- a/gcc/match.pd
> +++ b/gcc/match.pd
> @@ -281,6 +281,25 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT)
> (outer_op @0 @2)
> @3))))))
>
> +#if GENERIC
> +/* Remove superfluous NON_LVALUE_EXPR in unary operators. */
> +(for op (abs absu bit_not conj convert fix_trunc fixed_convert float
> + negate non_lvalue nop_convert)
> + (simplify (op (non_lvalue @0))
> + (op @0)))
> +
> +/* Remove superfluous NON_LVALUE_EXPR in binary operators. */
> +(for op (tcc_comparison plus minus mult pointer_plus pointer_diff
> + trunc_div ceil_div floor_div round_div exact_div rdiv
> + trunc_mod ceil_mod floor_mod round_mod min max
> + lshift rshift lrotate rrotate bit_ior bit_xor bit_and
> + complex widen_sum widen_mult widen_lshift)
> + (simplify (op (non_lvalue @0) @1)
> + (op @0 @1))
> + (simplify (op @0 (non_lvalue @1))
> + (op @0 @1)))
> +#endif
Hmm. fold-const.cc got arount this by matching on STRIP_NOPS applied operands.
So maybe instead alter genmatch.cc:dt_operand::gen_generic_expr to emit a
if (TREE_CODE (..) == NON_LVALUE_EXPR)
.. = TREE_OPERAND (.., 0);
? Thus, turn
case LSHIFT_EXPR:
{
tree _q50 = TREE_OPERAND (_p1, 0);
tree _q51 = TREE_OPERAND (_p1, 1);
into
case LSHIFT_EXPR:
{
tree _q50 = TREE_OPERAND (_p1, 0);
if (TREE_CODE (_q50) == NON_LVALUE_EXPR)
_q50 = TREE_OPERAND (_q50,0 );
tree _q51 = TREE_OPERAND (_p1, 1);
if (TREE_CODE (_q51) == NON_LVALUE_EXPR)
_q51 = TREE_OPERAND (_q51,0 );
?
> +
> /* Simplify x - x.
> This is unsafe for certain floats even in non-IEEE formats.
> In IEEE, it is unsafe because it does wrong for NaNs.
> diff --git a/gcc/testsuite/gfortran.dg/non_lvalue_2.f90
> b/gcc/testsuite/gfortran.dg/non_lvalue_2.f90
> new file mode 100644
> index 00000000000..24eff12ea4d
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/non_lvalue_2.f90
> @@ -0,0 +1,58 @@
> +! { dg-do compile }
> +! { dg-additional-options "-funsigned -fdump-tree-original" }
> +!
> +! Check the unwrapping of the NON_LVALUE_EXPR that may com from an earlier
> +! simplification, if it is used in a unary operator context.
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to an absolute
> value
> +! operator.
> +function f1 (f1_arg1)
> + integer, value :: f1_arg1
> + integer :: f1
> + f1 = abs(f1_arg1 + 0)
> +end function
> +! { dg-final { scan-tree-dump {__result_f1 = ABS_EXPR <f1_arg1>;} "original"
> } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a complement
> +! operator.
> +function f2 (f2_arg1)
> + integer, value :: f2_arg1
> + integer :: f2
> + f2 = not(f2_arg1 + 0)
> +end function
> +! { dg-final { scan-tree-dump {__result_f2 = ~f2_arg1;} "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a conjugate
> +! operator.
> +function f3 (f3_arg1)
> + complex, value :: f3_arg1
> + complex :: f3
> + f3 = conjg(conjg(conjg(f3_arg1)))
> +end function
> +! { dg-final { scan-tree-dump {__result_f3 = CONJ_EXPR <f3_arg1>;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a type
> conversion
> +! operator.
> +function f4 (f4_arg1)
> + integer(kind=4), value :: f4_arg1
> + integer(kind=8) :: f4
> + f4 = f4_arg1 + 0
> +end function
> +! { dg-final { scan-tree-dump {__result_f4 = \(integer\(kind=8\)\) f4_arg1;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a float
> conversion
> +! operator.
> +function f5 (f5_arg1)
> + integer, value :: f5_arg1
> + real :: f5
> + f5 = f5_arg1 + 0
> +end function
> +! { dg-final { scan-tree-dump {__result_f5 = \(real\(kind=4\)\) f5_arg1;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a negate
> operator.
> +function f6 (f6_arg1)
> + integer, value :: f6_arg1
> + integer :: f6
> + f6 = -not(not(f6_arg1))
> +end function
> +! { dg-final { scan-tree-dump {__result_f6 = -f6_arg1;} "original" } }
> diff --git a/gcc/testsuite/gfortran.dg/non_lvalue_3.f90
> b/gcc/testsuite/gfortran.dg/non_lvalue_3.f90
> new file mode 100644
> index 00000000000..280859c133b
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/non_lvalue_3.f90
> @@ -0,0 +1,172 @@
> +! { dg-do compile }
> +! { dg-additional-options "-fdump-tree-original" }
> +!
> +! Check the unwrapping of the NON_LVALUE_EXPR that may come from an earlier
> +! simplification, if it is used in a binary operator context.
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a LT logical
> +! operator
> +subroutine f01 (f01_res1, f01_res2, f01_arg1, f01_arg2)
> + integer, value :: f01_arg1, f01_arg2
> + logical, intent(out) :: f01_res1, f01_res2
> + f01_res1 = f01_arg1 + 0 .lt. f01_arg2
> + f01_res2 = f01_arg1 .lt. f01_arg2 + 0
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f01_res1 = f01_arg1 < f01_arg2;} "original"
> } }
> +! { dg-final { scan-tree-dump {\*f01_res2 = f01_arg1 < f01_arg2;} "original"
> } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a LE logical
> +! operator
> +subroutine f02 (f02_res1, f02_res2, f02_arg1, f02_arg2)
> + integer, value :: f02_arg1, f02_arg2
> + logical, intent(out) :: f02_res1, f02_res2
> + f02_res1 = f02_arg1 + 0 .le. f02_arg2
> + f02_res2 = f02_arg1 .le. f02_arg2 + 0
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f02_res1 = f02_arg1 <= f02_arg2;}
> "original" } }
> +! { dg-final { scan-tree-dump {\*f02_res2 = f02_arg1 <= f02_arg2;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a GT logical
> +! operator
> +subroutine f03 (f03_res1, f03_res2, f03_arg1, f03_arg2)
> + integer, value :: f03_arg1, f03_arg2
> + logical, intent(out) :: f03_res1, f03_res2
> + f03_res1 = f03_arg1 + 0 .gt. f03_arg2
> + f03_res2 = f03_arg1 .gt. f03_arg2 + 0
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f03_res1 = f03_arg1 > f03_arg2;} "original"
> } }
> +! { dg-final { scan-tree-dump {\*f03_res2 = f03_arg1 > f03_arg2;} "original"
> } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a GE logical
> +! operator
> +subroutine f04 (f04_res1, f04_res2, f04_arg1, f04_arg2)
> + integer, value :: f04_arg1, f04_arg2
> + logical, intent(out) :: f04_res1, f04_res2
> + f04_res1 = f04_arg1 + 0 .ge. f04_arg2
> + f04_res2 = f04_arg1 .ge. f04_arg2 + 0
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f04_res1 = f04_arg1 >= f04_arg2;}
> "original" } }
> +! { dg-final { scan-tree-dump {\*f04_res2 = f04_arg1 >= f04_arg2;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a LTGT logical
> +! operator
> +subroutine f05 (f05_res1, f05_res2, f05_arg1, f05_arg2)
> + real, value :: f05_arg1, f05_arg2
> + logical, intent(out) :: f05_res1, f05_res2
> + f05_res1 = f05_arg1 * 1 .lt. f05_arg2 .or. f05_arg1 * 1 .gt. f05_arg2
> + f05_res2 = f05_arg1 .lt. f05_arg2 * 1 .or. f05_arg1 .gt. f05_arg2 * 1
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f05_res1 = f05_arg1 <> f05_arg2;}
> "original" } }
> +! { dg-final { scan-tree-dump {\*f05_res2 = f05_arg1 <> f05_arg2;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a EQ logical
> +! operator
> +subroutine f06 (f06_res1, f06_res2, f06_arg1, f06_arg2)
> + integer, value :: f06_arg1, f06_arg2
> + logical, intent(out) :: f06_res1, f06_res2
> + f06_res1 = f06_arg1 + 0 .eq. f06_arg2
> + f06_res2 = f06_arg1 .eq. f06_arg2 + 0
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f06_res1 = f06_arg1 == f06_arg2;}
> "original" } }
> +! { dg-final { scan-tree-dump {\*f06_res2 = f06_arg1 == f06_arg2;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a NE logical
> +! operator
> +subroutine f07 (f07_res1, f07_res2, f07_arg1, f07_arg2)
> + integer, value :: f07_arg1, f07_arg2
> + logical, intent(out) :: f07_res1, f07_res2
> + f07_res1 = f07_arg1 + 0 .ne. f07_arg2
> + f07_res2 = f07_arg1 .ne. f07_arg2 + 0
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f07_res1 = f07_arg1 != f07_arg2;}
> "original" } }
> +! { dg-final { scan-tree-dump {\*f07_res2 = f07_arg1 != f07_arg2;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a PLUS operator
> +subroutine f08 (f08_res1, f08_res2, f08_arg1, f08_arg2)
> + integer, value :: f08_arg1, f08_arg2
> + integer, intent(out) :: f08_res1, f08_res2
> + f08_res1 = f08_arg1 * 1 + f08_arg2
> + f08_res2 = f08_arg1 + f08_arg2 * 1
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f08_res1 = f08_arg1 \+ f08_arg2;}
> "original" } }
> +! { dg-final { scan-tree-dump {\*f08_res2 = f08_arg1 \+ f08_arg2;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a MINUS operator
> +subroutine f09 (f09_res1, f09_res2, f09_arg1, f09_arg2)
> + integer, value :: f09_arg1, f09_arg2
> + integer, intent(out) :: f09_res1, f09_res2
> + f09_res1 = f09_arg1 * 1 - f09_arg2
> + f09_res2 = f09_arg1 - f09_arg2 * 1
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f09_res1 = f09_arg1 - f09_arg2;} "original"
> } }
> +! { dg-final { scan-tree-dump {\*f09_res2 = f09_arg1 - f09_arg2;} "original"
> } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a MULT operator
> +subroutine f10 (f10_res1, f10_res2, f10_arg1, f10_arg2)
> + integer, value :: f10_arg1, f10_arg2
> + integer, intent(out) :: f10_res1, f10_res2
> + f10_res1 = not(not(f10_arg1)) * f10_arg2
> + f10_res2 = f10_arg1 * not(not(f10_arg2))
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f10_res1 = f10_arg1 \* f10_arg2;}
> "original" } }
> +! { dg-final { scan-tree-dump {\*f10_res2 = f10_arg1 \* f10_arg2;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a DIV operator
> +subroutine f11 (f11_res1, f11_res2, f11_arg1, f11_arg2)
> + integer, value :: f11_arg1, f11_arg2
> + integer, intent(out) :: f11_res1, f11_res2
> + f11_res1 = not(not(f11_arg1)) / f11_arg2
> + f11_res2 = f11_arg1 / not(not(f11_arg2))
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f11_res1 = f11_arg1 / f11_arg2;} "original"
> } }
> +! { dg-final { scan-tree-dump {\*f11_res2 = f11_arg1 / f11_arg2;} "original"
> } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a MOD operator
> +subroutine f12 (f12_res1, f12_res2, f12_arg1, f12_arg2)
> + integer, value :: f12_arg1, f12_arg2
> + integer, intent(out) :: f12_res1, f12_res2
> + f12_res1 = mod(f12_arg1 + 0, f12_arg2)
> + f12_res2 = mod(f12_arg1, f12_arg2 + 0)
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f12_res1 = f12_arg1 % f12_arg2;} "original"
> } }
> +! { dg-final { scan-tree-dump {\*f12_res2 = f12_arg1 % f12_arg2;} "original"
> } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to an OR operator
> +subroutine f13 (f13_res1, f13_res2, f13_arg1, f13_arg2)
> + integer, value :: f13_arg1, f13_arg2
> + integer, intent(out) :: f13_res1, f13_res2
> + f13_res1 = ior(f13_arg1 + 0, f13_arg2)
> + f13_res2 = ior(f13_arg1, f13_arg2 + 0)
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f13_res1 = f13_arg1 \| f13_arg2;}
> "original" } }
> +! { dg-final { scan-tree-dump {\*f13_res2 = f13_arg1 \| f13_arg2;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a XOR operator
> +subroutine f14 (f14_res1, f14_res2, f14_arg1, f14_arg2)
> + integer, value :: f14_arg1, f14_arg2
> + integer, intent(out) :: f14_res1, f14_res2
> + f14_res1 = ieor(f14_arg1 + 0, f14_arg2)
> + f14_res2 = ieor(f14_arg1, f14_arg2 + 0)
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f14_res1 = f14_arg1 \^ f14_arg2;}
> "original" } }
> +! { dg-final { scan-tree-dump {\*f14_res2 = f14_arg1 \^ f14_arg2;}
> "original" } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to an AND operator
> +subroutine f15 (f15_res1, f15_res2, f15_arg1, f15_arg2)
> + integer, value :: f15_arg1, f15_arg2
> + integer, intent(out) :: f15_res1, f15_res2
> + f15_res1 = iand(f15_arg1 + 0, f15_arg2)
> + f15_res2 = iand(f15_arg1, f15_arg2 + 0)
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f15_res1 = f15_arg1 & f15_arg2;} "original"
> } }
> +! { dg-final { scan-tree-dump {\*f15_res2 = f15_arg1 & f15_arg2;} "original"
> } }
> +
> +! The NON_LVALUE_EXPR is dropped if it's used as argument to a complex
> constructor
> +subroutine f16 (f16_res1, f16_res2, f16_arg1, f16_arg2)
> + real, value :: f16_arg1, f16_arg2
> + complex, intent(out) :: f16_res1, f16_res2
> + f16_res1 = cmplx(f16_arg1 * 1, f16_arg2)
> + f16_res2 = cmplx(f16_arg1, f16_arg2 * 1)
> +end subroutine
> +! { dg-final { scan-tree-dump {\*f16_res1 = COMPLEX_EXPR <f16_arg1,
> f16_arg2>;} "original" } }
> +! { dg-final { scan-tree-dump {\*f16_res2 = COMPLEX_EXPR <f16_arg1,
> f16_arg2>;} "original" } }
> --
> 2.47.2
>
