1--  { dg-do run }
2
3procedure Array33 is
4  generic
5    type Item_T is private; -- The type of which the interval is made of.
6    type Bound_T is private;
7    None_Bound : Bound_T;
8    Bounds_Are_Static : Boolean := False;
9    type Value_T is private;
10    type Base_Index_T is range <>;
11  package General_Interval_Partition_G is
12    subtype Length_T is Base_Index_T range 0 .. Base_Index_T'Last;
13    subtype Index_T  is Base_Index_T range 1 .. Base_Index_T'Last;
14    type T is private;
15    function Single (First, Last : Bound_T; Value : Value_T) return T;
16    function Single1 (First, Last : Bound_T; Value : Value_T) return T;
17  private
18    type Bounds_Array_T is array (Length_T range <>) of Bound_T;
19    type Values_Array_T is array (Index_T  range <>) of Value_T;
20
21    First_Bounds_Index : constant Length_T
22        := 2 * Boolean'Pos (Bounds_Are_Static);
23    -- See below explanation on indexing the bounds.
24
25
26    type Obj_T (Length : Length_T) is
27      record
28        Bounds : Bounds_Array_T (First_Bounds_Index .. Length)
29           := (others => None_Bound);
30        -- This is tricky. If Bounds_Are_Static is true, the array does not
31        --  store the lower or upper bound.
32        -- This lowers memory requirements for the data structure at the cost
33        --  of slightly more complex indexing.
34        --
35        -- Bounds as seen internally depending on the parameter:
36        --
37        -- Bounds_Are_Static | Lower_Bound | Inbetween Bounds (if any) | Upper_Bound
38        --     True         => Max_First   & Bounds (2 .. Length)      & Min_Last
39        --     False        => Bounds (0)  & Bounds (1 .. Length - 1)  & Bounds (Length)
40        --
41        Values : Values_Array_T (1 .. Length);
42      end record;
43
44    type T is access Obj_T;
45    --@@ if ccf:defined(debug_pool) then
46    --@@! for T'Storage_Pool use Pool_Selection_T'Storage_Pool;
47    --@@ end if
48
49  end General_Interval_Partition_G;
50
51  package body General_Interval_Partition_G is
52
53    function Single (First, Last : Bound_T; Value : Value_T) return T is
54    begin
55      return new Obj_T'(Length => 1,
56                        Bounds => (if Bounds_Are_Static
57                                   then (2 .. 0 => None_Bound)
58                --  Now raises constraint error here
59                                   else (0 => First, 1 => Last)),
60                        Values => (1 => Value));
61    end Single;
62    function Single1 (First, Last : Bound_T; Value : Value_T) return T is
63    begin
64      return new Obj_T'( 1,
65                         (if Bounds_Are_Static
66                                   then (2 .. 0 => None_Bound)
67                --  Now raises constraint error here
68                                   else (0 => First, 1 => Last)),
69                        (1 => Value));
70    end Single1;
71  end General_Interval_Partition_G;
72
73  type T is new Integer;
74
75  package Partition is new General_Interval_Partition_G (Item_T            => T,
76                                                         Bound_T           => T,
77                                                         None_Bound        => 0,
78                                                         Bounds_Are_Static => True,
79                                                         Value_T           => T,
80                                                         Base_Index_T      => Natural);
81  X : constant Partition.T := Partition.Single (1,1,1);
82  Z : constant Partition.T := Partition.Single1 (1,1,1);
83begin
84  null;
85end;
86