-- { 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;