-- CC510103.AM -- -- Grant of Unlimited Rights -- -- The Ada Conformity Assessment Authority (ACAA) holds unlimited -- rights in the software and documentation contained herein. Unlimited -- rights are the same as those granted by the U.S. Government for older -- parts of the Ada Conformity Assessment Test Suite, and are defined -- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA -- intends to confer upon all recipients unlimited rights equal to those -- held by the ACAA. These rights include rights to use, duplicate, -- release or disclose the released technical data and computer software -- in whole or in part, in any manner and for any purpose whatsoever, and -- to have or permit others to do so. -- -- DISCLAIMER -- -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR -- DISCLOSED ARE AS IS. THE ACAA MAKES NO EXPRESS OR IMPLIED -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A -- PARTICULAR PURPOSE OF SAID MATERIAL. -- -- Notice -- -- The ACAA has created and maintains the Ada Conformity Assessment Test -- Suite for the purpose of conformity assessments conducted in accordance -- with the International Standard ISO/IEC 18009 - Ada: Conformity -- assessment of a language processor. This test suite should not be used -- to make claims of conformance unless used in accordance with -- ISO/IEC 18017 and any applicable ACAA procedures. -- --* -- -- OBJECTIVE -- See CC510100.A. -- -- TEST DESCRIPTION -- See CC510100.A. -- -- SPECIAL REQUIREMENTS -- See CC510100.A. -- -- TEST FILES: -- This test consists of the following files: -- CC510100.A -- CC510101.A -- CC510102.A -- -> CC510103.AM -- -- CHANGE HISTORY: -- 06 Jan 2015 RLB Split test into individual files. -- 17 Mar 2015 RLB Moved body of CC51010_2 here. -- 19 Mar 2015 RLB Made parameter in out. -- --! with CC51010_1; use CC51010_1; with Report; package body CC51010_2 is Elt_Value : constant Integer := 17; function Access_To (Obj : in out CC51010_1.Set) return access CC51010_1.Set is begin return Obj'Unchecked_Access; -- If we know that Set is nonlimited, we could make this more useful -- by allocating a copy; but then the generic would need a cleanup -- procedure formal. That would make sense in a real container, -- as it would make the container more flexible. end Access_To; procedure Do_Test is S1 : CC51010_1.Set; S2 : CC51010_1.Set; S3 : CC51010_1.Set; My_Map : A_Map_of_Sets.Map_Type; begin -- Initialize S1 to { 1 .. 10 } for I in Integer range 1 .. 10 loop Add (I, S1); end loop; A_Map_of_Sets.Insert (Map => My_Map, Key => 1, Elem => S1); -- Initialize S2 to { 5 .. 15 } for I in Integer range 5 .. 15 loop Add (I, S2); end loop; A_Map_of_Sets.Insert (Map => My_Map, Key => 2, Elem => S2); -- Initialize S3 to { 20 .. 25 } for I in Integer range 20 .. 25 loop Add (I, S3); end loop; A_Map_of_Sets.Insert (Map => My_Map, Key => 3, Elem => S3); -- Get elements from Map by key, check if they are correct: if A_Map_of_Sets.Element (Map => My_Map, Key => 2).all /= S2 then Report.Failed ("Wrong set retrieved from map - 1st read"); end if; if A_Map_of_Sets.Element (Map => My_Map, Key => 1).all /= S1 then Report.Failed ("Wrong set retrieved from map - 2nd read"); end if; if A_Map_of_Sets.Element (Map => My_Map, Key => 3).all /= S3 then Report.Failed ("Wrong set retrieved from map - 3rd read"); end if; end Do_Test; end CC51010_2; --==================================================================-- package body CC51010_1 is procedure Add (Elem : Integer; To_Set : in out Set) is Found : Boolean := False; begin for E in To_Set.Integers'first .. To_Set.Last_Integer loop if To_Set.Integers (E) = Elem then Found := True; exit; end if; end loop; if not Found then To_Set.Last_Integer := To_Set.Last_Integer + 1; To_Set.Integers (To_Set.Last_Integer) := Elem; end if; end Add; function Union (Left, Right : Set) return Set is Result : Set := Left; Found : Boolean; begin for ER in Right.Integers'first .. Right.Last_Integer loop Found := False; for EL in Left.Integers'first .. Left.Last_Integer loop if Left.Integers (EL) = Right.Integers (ER) then Found := True; exit; end if; end loop; if not Found then Result.Last_Integer := Result.Last_Integer + 1; Result.Integers (Result.Last_Integer) := Right.Integers (ER); end if; end loop; return Result; end Union; function Intersection (Left, Right : Set) return Set is Result : Set; begin for ER in Right.Integers'first .. Right.Last_Integer loop for EL in Left.Integers'first .. Left.Last_Integer loop if Left.Integers (EL) = Right.Integers (ER) then Result.Last_Integer := Result.Last_Integer + 1; Result.Integers (Result.Last_Integer) := Right.Integers (ER); exit; end if; end loop; end loop; return Result; end Intersection; function "=" (Left, Right : Set) return Boolean is begin if Left.Last_Integer /= Right.Last_Integer then return False; end if; for ER in Right.Integers'first .. Right.Last_Integer loop declare Found_Integer : Boolean := False; begin for EL in Left.Integers'first .. Left.Last_Integer loop if Left.Integers (EL) = Right.Integers (ER) then Found_Integer := True; exit; end if; end loop; if not Found_Integer then return False; end if; end; end loop; return True; end "="; end CC51010_1; --==================================================================-- with CC51010_2; with Report; procedure CC51010 is begin Report.Test ("CC51010", "Check that a generic unit with a tagged " & "incomplete formal types can be instantiated with an " & "incomplete view of a type from a limited withed package, " & "and that operations in the instance can be used normally " & "when the full view of the type is visible"); CC51010_2.Do_Test; Report.Result; end CC51010;