-- cy100006.ada -- -- Grant of Unlimited Rights -- -- Ada Core Technologies Inc. (AdaCore) 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, AdaCore intends -- to confer upon all recipients unlimited rights equal to those held by -- the Ada Conformity Assessment Authority. 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. ADACORE 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. -- -------------------------------------------------------------------------- --* -- COPYRIGHT: -- Ada Core Technologies, Inc. -- -- AUTHOR: -- Javier Miranda -- -- OBJECTIVE: -- Check AI-50217 plus AI-262 (limited-private-with clauses). -- Test based in the example proposed by the ARG and discussed -- in AI-50217.TXT -- -- CHANGE HISTORY: -- 22 MAY 2004 JM Initial Version -- 12 JAN 2005 RLB Put main subprogram last. --! package CY100006P is end CY100006P; -- ------------------------------------------------------------------------- limited private with CY100006P.E; package CY100006P.D is type Department is tagged private; type Emp_Ptr is access all CY100006P.E.Employee'Class; procedure Choose_Manager (D : in out Department; Manager : out Emp_Ptr); private type T_List is array (Positive range <>) of Emp_Ptr; type Department is tagged record List : T_List (1 .. 5); Tot : Natural := 0; end record; end CY100006P.D; -- ------------------------------------------------------------------------- limited private with CY100006P.D; package CY100006P.E is type Employee is tagged private; type Emp_Ptr is access all Employee'Class; -- used by function 'hire' type Dept_Ptr is access all CY100006P.D.Department'Class; type Name is access String; procedure Assign_Employee (E : in out Employee; D : in Dept_Ptr); function Hire (Id : Name) return Emp_Ptr; function Current_Department (E : in Employee) return Dept_Ptr; private type Employee is tagged record Dept : Dept_Ptr; Id : Name; end record; end CY100006P.E; -- ------------------------------------------------------------------------- with Report; with CY100006P.E; use CY100006P.E; package body CY100006P.D is procedure Choose_Manager (D : in out Department; Manager : out Emp_Ptr) is begin Manager := D.List (1); end Choose_Manager; end CY100006P.D; -- ------------------------------------------------------------------------- with Report; with CY100006P.D; package body CY100006P.E is procedure Assign_Employee (E : in out Employee; D : in Dept_Ptr) is begin E.Dept := D; end Assign_Employee; function Current_Department (E : in Employee) return Dept_Ptr is begin return E.Dept; end Current_Department; function Hire (Id : Name) return Emp_Ptr is Ptr : Emp_Ptr := new Employee; begin Ptr.Id := Id; return Ptr; end Hire; end CY100006P.E; -- ------------------------------------------------------------------------- package CY100006P.Main is procedure Main; end CY100006P.Main; -- ------------------------------------------------------------------------- with Report; private with CY100006P.D; use CY100006P.D; private with CY100006P.E; use CY100006P.E; package body CY100006P.Main is procedure Main is Names : array (1 .. 3) of Name := (new String'("Jones"), new String'("Smith"), new String '("Doe")); Dept : Department; Emp : Employee; begin Report.Test ("CY100006", "Limited Private With Clauses (AI-50217, " & "AI-262): Test based in the ARG example described in " & "AI-50217 (implemented with a hierarchical library)"); -- for N in Names'Range loop -- declare -- E : CY100006P.E.Emp_Ptr := Hire (Names (N)); -- begin -- Appoint (CY100006P.D.Emp_Ptr (E), Dept); -- end; -- end loop; -- Display (Dept); Report.Result; end Main; end CY100006P.Main; -- ------------------------------------------------------------------------- with Report; with CY100006P.Main; use CY100006P.Main; procedure CY100006 is begin Main; end CY100006;