@@ -404,10 +404,9 @@ is
elsif Result_Subtype'Base'Size > 32 then
declare
- -- In the 64-bit case, we have to be careful, since not all 64-bit
- -- unsigned values are representable in GNAT's root_integer type.
- -- Ignore different-size warnings here since GNAT's handling
- -- is correct.
+ -- In the 64-bit case, we have to be careful since not all 64-bit
+ -- unsigned values are representable in GNAT's universal integer.
+ -- Ignore unequal-size warnings since GNAT's handling is correct.
pragma Warnings ("Z");
function Conv_To_Unsigned is
@@ -423,7 +422,8 @@ is
begin
if N = 0 then
- return Conv_To_Result (Conv_To_Unsigned (Min) + Random (Gen));
+ X := Random (Gen);
+ return Conv_To_Result (Conv_To_Unsigned (Min) + X);
else
Slop := Unsigned_64'Last rem N + 1;
@@ -437,28 +437,73 @@ is
end if;
end;
- elsif Result_Subtype'Pos (Max) - Result_Subtype'Pos (Min) =
- 2 ** 32 - 1
- then
- return Result_Subtype'Val
- (Result_Subtype'Pos (Min) + Unsigned_32'Pos (Random (Gen)));
else
declare
- N : constant Unsigned_32 :=
- Unsigned_32 (Result_Subtype'Pos (Max) -
- Result_Subtype'Pos (Min) + 1);
- Slop : constant Unsigned_32 := Unsigned_32'Last rem N + 1;
- X : Unsigned_32;
+ -- In the 32-bit case, unlike the above case, we need to handle
+ -- both integer and enumeration types. If the values of the result
+ -- subtype are contiguous, then we can still use the above trick.
+ -- Otherwise we need to rely on 'Pos and 'Val in the computation,
+ -- which is more costly since it will thus be done in universal
+ -- integer. And ignore unequal-size warnings in this case too.
+
+ pragma Warnings ("Z");
+ function Conv_To_Unsigned is
+ new Unchecked_Conversion (Result_Subtype'Base, Unsigned_32);
+ function Conv_To_Result is
+ new Unchecked_Conversion (Unsigned_32, Result_Subtype'Base);
+ pragma Warnings ("z");
+
+ Contiguous : constant Boolean :=
+ Result_Subtype'Pos (Result_Subtype'Last) -
+ Result_Subtype'Pos (Result_Subtype'First)
+ =
+ Result_Subtype'Enum_Rep (Result_Subtype'Last) -
+ Result_Subtype'Enum_Rep (Result_Subtype'First);
+
+ N, X, Slop : Unsigned_32;
begin
- loop
- X := Random (Gen);
- exit when Slop = N or else X <= Unsigned_32'Last - Slop;
- end loop;
+ if Contiguous then
+ N := Conv_To_Unsigned (Max) - Conv_To_Unsigned (Min) + 1;
+
+ if N = 0 then
+ X := Random (Gen);
+ return Conv_To_Result (Conv_To_Unsigned (Min) + X);
+
+ else
+ Slop := Unsigned_32'Last rem N + 1;
- return
- Result_Subtype'Val
- (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X rem N));
+ loop
+ X := Random (Gen);
+ exit when Slop = N or else X <= Unsigned_32'Last - Slop;
+ end loop;
+
+ return Conv_To_Result (Conv_To_Unsigned (Min) + X rem N);
+ end if;
+
+ else
+ N := Unsigned_32 (Result_Subtype'Pos (Max) -
+ Result_Subtype'Pos (Min) + 1);
+
+ if N = 0 then
+ X := Random (Gen);
+ return
+ Result_Subtype'Val
+ (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X));
+
+ else
+ Slop := Unsigned_32'Last rem N + 1;
+
+ loop
+ X := Random (Gen);
+ exit when Slop = N or else X <= Unsigned_32'Last - Slop;
+ end loop;
+
+ return
+ Result_Subtype'Val
+ (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X rem N));
+ end if;
+ end if;
end;
end if;
end Random_Discrete;