blob: 3e146748f2137eecd737d237b69c87adff402861 [file] [log] [blame]
-- { dg-do run }
procedure Array33 is
generic
type Item_T is private; -- The type of which the interval is made of.
type Bound_T is private;
None_Bound : Bound_T;
Bounds_Are_Static : Boolean := False;
type Value_T is private;
type Base_Index_T is range <>;
package General_Interval_Partition_G is
subtype Length_T is Base_Index_T range 0 .. Base_Index_T'Last;
subtype Index_T is Base_Index_T range 1 .. Base_Index_T'Last;
type T is private;
function Single (First, Last : Bound_T; Value : Value_T) return T;
function Single1 (First, Last : Bound_T; Value : Value_T) return T;
private
type Bounds_Array_T is array (Length_T range <>) of Bound_T;
type Values_Array_T is array (Index_T range <>) of Value_T;
First_Bounds_Index : constant Length_T
:= 2 * Boolean'Pos (Bounds_Are_Static);
-- See below explanation on indexing the bounds.
type Obj_T (Length : Length_T) is
record
Bounds : Bounds_Array_T (First_Bounds_Index .. Length)
:= (others => None_Bound);
-- This is tricky. If Bounds_Are_Static is true, the array does not
-- store the lower or upper bound.
-- This lowers memory requirements for the data structure at the cost
-- of slightly more complex indexing.
--
-- Bounds as seen internally depending on the parameter:
--
-- Bounds_Are_Static | Lower_Bound | Inbetween Bounds (if any) | Upper_Bound
-- True => Max_First & Bounds (2 .. Length) & Min_Last
-- False => Bounds (0) & Bounds (1 .. Length - 1) & Bounds (Length)
--
Values : Values_Array_T (1 .. Length);
end record;
type T is access Obj_T;
--@@ if ccf:defined(debug_pool) then
--@@! for T'Storage_Pool use Pool_Selection_T'Storage_Pool;
--@@ end if
end General_Interval_Partition_G;
package body General_Interval_Partition_G is
function Single (First, Last : Bound_T; Value : Value_T) return T is
begin
return new Obj_T'(Length => 1,
Bounds => (if Bounds_Are_Static
then (2 .. 0 => None_Bound)
-- Now raises constraint error here
else (0 => First, 1 => Last)),
Values => (1 => Value));
end Single;
function Single1 (First, Last : Bound_T; Value : Value_T) return T is
begin
return new Obj_T'( 1,
(if Bounds_Are_Static
then (2 .. 0 => None_Bound)
-- Now raises constraint error here
else (0 => First, 1 => Last)),
(1 => Value));
end Single1;
end General_Interval_Partition_G;
type T is new Integer;
package Partition is new General_Interval_Partition_G (Item_T => T,
Bound_T => T,
None_Bound => 0,
Bounds_Are_Static => True,
Value_T => T,
Base_Index_T => Natural);
X : constant Partition.T := Partition.Single (1,1,1);
Z : constant Partition.T := Partition.Single1 (1,1,1);
begin
null;
end;