Also I have that line:
Deck := (Deck.List'Length - 1, Deck.list(2..Deck.List'Length));
That invariably raises the following error at runtime:
raised CONSTRAINT_ERROR : card_package.adb:23 discriminant check failed
Why can’t I change the discriminant in an aggregate ?
I think this might have been a side-effect of other problems with the code.
Default_List has the inner loop in the wrong place. It should be:
for I in 1..Card_Number loop
loop
Random_Card := (Random(Suite_Gen),Random(Value_Gen));
exit when not Cards_Done (Random_Card.Suite,Random_Card.Value);
end loop;
List(I) := Random_Card;
Cards_Done (Random_Card.Suite, Random_Card.Value) := true;
end loop;
Shuffle is calling Random twice per swap, when I believe you should only call it once:
for I in Deck.List'Range loop
Inter := Deck.list(I);
Ran := Random(Gen);
Deck.list(I) := Deck.list(Ran);
Deck.list(Ran) := Inter;
end loop;
You are using 'Length in a few places where 'Last would be more appropriate, though since most of your arrays generally are indexed starting with 1, 'Last and 'Length are the same, even though 'Last is more appropriate when indexing into the array.
Here is a version of your Card_Package that I got to work:
pragma Ada_2022;
pragma Extensions_Allowed (On);
with Ada.Numerics.Discrete_Random;
package body Card_Package is
procedure Shuffle (Deck: in out Card_Deck) is
subtype real_card_number is Card_Number_type range Deck.List'Range;
package NR is new Ada.Numerics.Discrete_Random(real_card_number);
use NR;
Gen: Generator;
Inter: Cards;
Ran : Real_Card_Number;
begin
for I in Deck.List'Range loop
Inter := Deck.list(I);
Ran := Random(Gen);
Deck.list(I) := Deck.list(Ran);
Deck.list(Ran) := Inter;
end loop;
end Shuffle;
procedure Deal (Card: out Cards; Deck: in out Card_Deck) is
begin
if Deck.Number < 1 then raise Constraint_Error; end if;
Card := Deck.List(Deck.List'First);
Deck := (Deck.Number - 1, Deck.list(2..Deck.List'Last));
end Deal;
procedure Replace (Card: in Cards; Deck: in out Card_Deck) is
begin
if Deck.Number = Card_number_type'Last then raise Constraint_Error; end if;
Deck := (Deck.Number + 1, Deck.List & Card);
end Replace;
function Default_list (Card_number: Card_number_type) return Card_List is
package RSP is new Ada.Numerics.Discrete_Random (Card_suite);
package RVP is new Ada.Numerics.Discrete_Random (Card_value);
use RSP, RVP;
Value_Gen: RVP.Generator;
Suite_Gen: RSP.Generator;
type Array_boolean is array (Card_suite,Card_Value) of Boolean;
Cards_done: Array_boolean := (others => (others => False));
Random_Card: Cards;
List: Card_List (1..Card_Number);
begin
Reset(Value_Gen); Reset(Suite_Gen);
for I in 1..Card_Number loop
loop
Random_Card := (Random(Suite_Gen),Random(Value_Gen));
exit when not Cards_Done (Random_Card.Suite,Random_Card.Value);
end loop;
List(I) := Random_Card;
Cards_Done (Random_Card.Suite, Random_Card.Value) := true;
end loop;
return List;
end Default_list;
end Card_Package;
With this as my test program:
with Ada.Text_IO; use Ada.Text_IO;
with Card_Package; use Card_Package;
procedure Test_Card is
D : Card_Deck;
begin
Put_Line ("Shuffling");
Shuffle (D);
Put_Line ("Dealing");
New_Line;
for I in 1 .. Max_Card_Number loop
declare
C : Cards;
begin
Deal (C, D);
Put_Line (C.Value'Image & " of " & C.Suite'Image);
if I mod 13 = 0 then
New_Line;
end if;
end;
end loop;
end Test_Card;
