From 1e57ef5e8a0b9d30673c86271e2548f0905e4f4d Mon Sep 17 00:00:00 2001 From: Matthieu Eyraud Date: Tue, 12 Mar 2024 10:48:02 +0100 Subject: [PATCH] [TGen] Fix interval size computation in floating point generation When computing the number of floating point values in a given range, we were including a spurious binade, which could result in generating a floating point outside of the range. --- src/tgen/tgen_rts/tgen-random.adb | 2 +- testsuite/tests/test/153-floating-point-tgen/pkg.adb | 6 ++++++ testsuite/tests/test/153-floating-point-tgen/pkg.ads | 7 +++++++ testsuite/tests/test/153-floating-point-tgen/test.gpr | 4 ++++ testsuite/tests/test/153-floating-point-tgen/test.sh | 4 ++++ testsuite/tests/test/153-floating-point-tgen/test.yaml | 8 ++++++++ 6 files changed, 30 insertions(+), 1 deletion(-) create mode 100644 testsuite/tests/test/153-floating-point-tgen/pkg.adb create mode 100644 testsuite/tests/test/153-floating-point-tgen/pkg.ads create mode 100644 testsuite/tests/test/153-floating-point-tgen/test.gpr create mode 100755 testsuite/tests/test/153-floating-point-tgen/test.sh create mode 100644 testsuite/tests/test/153-floating-point-tgen/test.yaml diff --git a/src/tgen/tgen_rts/tgen-random.adb b/src/tgen/tgen_rts/tgen-random.adb index 49e6d04a..78f7ef41 100644 --- a/src/tgen/tgen_rts/tgen-random.adb +++ b/src/tgen/tgen_rts/tgen-random.adb @@ -303,7 +303,7 @@ package body TGen.Random is Nb_Values_Between := Unsigned_Type - (HB_Sign * Int_Type (HB_Exp) - LB_Sign * Int_Type (LB_Exp)) + (HB_Sign * Int_Type (HB_Exp) - LB_Sign * Int_Type (LB_Exp) - 1) * MS_Part; Nb_Values := diff --git a/testsuite/tests/test/153-floating-point-tgen/pkg.adb b/testsuite/tests/test/153-floating-point-tgen/pkg.adb new file mode 100644 index 00000000..41799e8c --- /dev/null +++ b/testsuite/tests/test/153-floating-point-tgen/pkg.adb @@ -0,0 +1,6 @@ +package body Pkg is + procedure Foo (P1 : My_Float) is + begin + null; + end Foo; +end Pkg; diff --git a/testsuite/tests/test/153-floating-point-tgen/pkg.ads b/testsuite/tests/test/153-floating-point-tgen/pkg.ads new file mode 100644 index 00000000..29f1386b --- /dev/null +++ b/testsuite/tests/test/153-floating-point-tgen/pkg.ads @@ -0,0 +1,7 @@ +with Ada.Numerics; use Ada.Numerics; + +package Pkg is + type Precision_6 is digits 6; + subtype My_Float is Precision_6 range -Pi .. Pi; + procedure Foo (P1 : My_Float); +end Pkg; diff --git a/testsuite/tests/test/153-floating-point-tgen/test.gpr b/testsuite/tests/test/153-floating-point-tgen/test.gpr new file mode 100644 index 00000000..419e6c6c --- /dev/null +++ b/testsuite/tests/test/153-floating-point-tgen/test.gpr @@ -0,0 +1,4 @@ +project Test is + for Source_Dirs use ("."); + for Object_Dir use "obj"; +end Test; diff --git a/testsuite/tests/test/153-floating-point-tgen/test.sh b/testsuite/tests/test/153-floating-point-tgen/test.sh new file mode 100755 index 00000000..ea397333 --- /dev/null +++ b/testsuite/tests/test/153-floating-point-tgen/test.sh @@ -0,0 +1,4 @@ +# Set the seed to a known crashing seed +export TGEN_RANDOM_SEED=389810392 +gnattest -P test.gpr --gen-test-vectors -q --gen-test-num 200 + diff --git a/testsuite/tests/test/153-floating-point-tgen/test.yaml b/testsuite/tests/test/153-floating-point-tgen/test.yaml new file mode 100644 index 00000000..805b6b5b --- /dev/null +++ b/testsuite/tests/test/153-floating-point-tgen/test.yaml @@ -0,0 +1,8 @@ +description: + This is a regression test case checking that TGen creates floating + point values in the range of a floating point type with a range + constraint. + +driver: shell_script +control: + - [XFAIL, 'x86', 'Marshalling not working for 32bits (UB03-008)']