From a540a806cf02d739a408f129738252e73f03e60c Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sat, 20 Aug 2022 20:36:28 +0200
Subject: [PATCH] Fortran: fix simplification of intrinsics IBCLR and IBSET
 [PR106557]

gcc/fortran/ChangeLog:

	PR fortran/106557
	* simplify.cc (gfc_simplify_ibclr): Ensure consistent results of
	the simplification by dropping a redundant memory representation
	of argument x.
	(gfc_simplify_ibset): Likewise.

gcc/testsuite/ChangeLog:

	PR fortran/106557
	* gfortran.dg/pr106557.f90: New test.
---
 gcc/fortran/simplify.cc                | 14 ++++++++++++++
 gcc/testsuite/gfortran.dg/pr106557.f90 | 19 +++++++++++++++++++
 2 files changed, 33 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/pr106557.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index fb725994653..f992c31e5d7 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -3380,6 +3380,13 @@ gfc_simplify_ibclr (gfc_expr *x, gfc_expr *y)
   k = gfc_validate_kind (x->ts.type, x->ts.kind, false);

   result = gfc_copy_expr (x);
+  /* Drop any separate memory representation of x to avoid potential
+     inconsistencies in result.  */
+  if (result->representation.string)
+    {
+      free (result->representation.string);
+      result->representation.string = NULL;
+    }

   convert_mpz_to_unsigned (result->value.integer,
 			   gfc_integer_kinds[k].bit_size);
@@ -3471,6 +3478,13 @@ gfc_simplify_ibset (gfc_expr *x, gfc_expr *y)
   k = gfc_validate_kind (x->ts.type, x->ts.kind, false);

   result = gfc_copy_expr (x);
+  /* Drop any separate memory representation of x to avoid potential
+     inconsistencies in result.  */
+  if (result->representation.string)
+    {
+      free (result->representation.string);
+      result->representation.string = NULL;
+    }

   convert_mpz_to_unsigned (result->value.integer,
 			   gfc_integer_kinds[k].bit_size);
diff --git a/gcc/testsuite/gfortran.dg/pr106557.f90 b/gcc/testsuite/gfortran.dg/pr106557.f90
new file mode 100644
index 00000000000..d073f3e7186
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr106557.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+! PR fortran/106557 - nesting intrinsics ibset and transfer gives wrong result
+
+program p
+  implicit none
+  character(1) :: s
+
+  write(s,'(i1)') ibset (transfer (0, 0), 0)
+  if (s /= '1') stop 1
+  write(s,'(i1)') ibclr (transfer (1, 0), 0)
+  if (s /= '0') stop 2
+
+  ! These shall be fully resolved at compile time:
+  if (transfer   (ibset (transfer (0, 0), 0), 0) /= 1) stop 3
+  if (transfer   (ibclr (transfer (1, 0), 0), 0) /= 0) stop 4
+end
+
+! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 2 "original" } }
--
2.35.3