From b567d3bd302933adb253aba9069fd8120c485441 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Wed, 2 Sep 2020 12:18:46 +0200 Subject: [PATCH] fortran: Fix o'...' boz to integer/real conversions [PR96859] The standard says that excess digits from boz are truncated. For hexadecimal or binary, the routines copy just the number of digits that will be needed, but for octal we copy number of digits that contain one extra bit (for 8-bit, 32-bit or 128-bit, i.e. kind 1, 4 and 16) or two extra bits (for 16-bit or 64-bit, i.e. kind 2 and 8). The clearing of the first bit is done correctly by changing the first digit if it is 4-7 to one smaller by 4 (i.e. modulo 4). The clearing of the first two bits is done by changing 4 or 6 to 0 and 5 or 7 to 1, which is incorrect, because we really want to change the first digit to 0 if it was even, or to 1 if it was odd, so digits 2 and 3 are mishandled by keeping them as is, rather than changing 2 to 0 and 3 to 1. 2020-09-02 Jakub Jelinek PR fortran/96859 * check.c (gfc_boz2real, gfc_boz2int): When clearing first two bits, change also '2' to '0' and '3' to '1' rather than just handling '4' through '7'. * gfortran.dg/pr96859.f90: New test. --- gcc/fortran/check.c | 8 ++++---- gcc/testsuite/gfortran.dg/pr96859.f90 | 25 +++++++++++++++++++++++++ 2 files changed, 29 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr96859.f90 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 65b46cd3f85..1e64fab3401 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -340,9 +340,9 @@ gfc_boz2real (gfc_expr *x, int kind) /* Clear first two bits. */ else { - if (buf[0] == '4' || buf[0] == '6') + if (buf[0] == '2' || buf[0] == '4' || buf[0] == '6') buf[0] = '0'; - else if (buf[0] == '5' || buf[0] == '7') + else if (buf[0] == '3' || buf[0] == '5' || buf[0] == '7') buf[0] = '1'; } } @@ -429,9 +429,9 @@ gfc_boz2int (gfc_expr *x, int kind) /* Clear first two bits. */ else { - if (buf[0] == '4' || buf[0] == '6') + if (buf[0] == '2' || buf[0] == '4' || buf[0] == '6') buf[0] = '0'; - else if (buf[0] == '5' || buf[0] == '7') + else if (buf[0] == '3' || buf[0] == '5' || buf[0] == '7') buf[0] = '1'; } } diff --git a/gcc/testsuite/gfortran.dg/pr96859.f90 b/gcc/testsuite/gfortran.dg/pr96859.f90 new file mode 100644 index 00000000000..ca41cefc782 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr96859.f90 @@ -0,0 +1,25 @@ +! PR fortran/96859 +! { dg-do run } + +program pr96859 + if (merge_bits(32767_2, o'1234567', 32767_2).ne.32767_2) stop 1 + if (merge_bits(o'1234567', 32767_2, o'1234567').ne.32767_2) stop 2 + if (merge_bits(32767_2, o'1234567', b'010101').ne.14711_2) stop 3 + if (merge_bits(32767_2, o'1234567', z'12345678').ne.32639_2) stop 4 + if (int (o'1034567', 2).ne.14711_2) stop 5 + if (int (o'1234567', 2).ne.14711_2) stop 6 + if (int (o'1434567', 2).ne.14711_2) stop 7 + if (int (o'1634567', 2).ne.14711_2) stop 8 + if (int (o'1134567', 2).ne.-18057_2) stop 9 + if (int (o'1334567', 2).ne.-18057_2) stop 10 + if (int (o'1534567', 2).ne.-18057_2) stop 11 + if (int (o'1734567', 2).ne.-18057_2) stop 12 + if (int (o'70123456776543211234567', 8).ne.1505855851274254711_8) stop 13 + if (int (o'72123456776543211234567', 8).ne.1505855851274254711_8) stop 14 + if (int (o'74123456776543211234567', 8).ne.1505855851274254711_8) stop 15 + if (int (o'76123456776543211234567', 8).ne.1505855851274254711_8) stop 16 + if (int (o'71123456776543211234567', 8).ne.-7717516185580521097_8) stop 17 + if (int (o'73123456776543211234567', 8).ne.-7717516185580521097_8) stop 18 + if (int (o'75123456776543211234567', 8).ne.-7717516185580521097_8) stop 19 + if (int (o'77123456776543211234567', 8).ne.-7717516185580521097_8) stop 20 +end -- 2.30.2