FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: fix simplification of intrinsics IBCLR and IBSET [PR106557]

Browse source 
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.
This commit is contained in:
Harald Anlauf 2022-08-20 20:36:28 +02:00
parent b6316324fc
commit 7e51df048a
2 changed files with 33 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
gcc/fortran/simplify.cc
View file

@ -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);

19
gcc/testsuite/gfortran.dg/pr106557.f90 Normal file
View file

@ -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" } }