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.

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index fb7259946537c5188b39d3d4b8aa024fe148a4d8..f992c31e5d74374bbb685fa2f6a5cbd7d352b89e 100644 (file)
--- 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 (file)
index 0000000..d073f3e
--- /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" } }