-- cy30037.a -- -- Grant of Unlimited Rights -- -- 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: -- AdaCore -- -- AUTHOR: -- Javier Miranda -- -- OBJECTIVE: -- Check AI-345 and AI-399 (abstract interface types) -- -- Check the usage of subprograms to cover interface primitives. -- -- CHANGE HISTORY: -- 15 May 2005 Initial Version --! with Report; procedure cy30037 is package pack is type Iface is task interface; procedure Prim1_1 (M : in out Iface) is abstract; procedure Prim1_2 (M : in Iface; Value : Integer) is abstract; function Prim2_1 (M : Iface) return Integer is abstract; function Prim2_2 (M : Iface; Value : Integer) return Integer is abstract; -- This protected type implements all the interface primitives -- as subprograms task type PO_T1 is new Iface with entry Dummy; end PO_T1; procedure Prim1_1 (O : in out PO_T1); procedure Prim1_2 (O : PO_T1; Value : Integer); function Prim2_1 (O : PO_T1) return Integer; function Prim2_2 (O : PO_T1; Value : Integer) return Integer; end pack; package body Pack is task body PO_T1 is begin loop select accept Dummy; or terminate; end select; end loop; end PO_T1; procedure Prim1_1 (O : in out PO_T1) is begin Report.Comment ("11"); end Prim1_1; procedure Prim1_2 (O : PO_T1; Value : Integer) is begin Report.Comment ("12"); end Prim1_2; function Prim2_1 (O : PO_T1) return Integer is begin Report.Comment ("21"); return 0; end Prim2_1; function Prim2_2 (O : PO_T1; Value : Integer) return Integer is begin Report.Comment ("22"); return 1; end Prim2_2; end Pack; use Pack; procedure Dispatch_Calls_1 (X : in out Iface'Class) is R : Integer; begin X.Prim1_1; X.Prim1_2 (10); R := X.Prim2_1; R := X.Prim2_2 (10); end Dispatch_Calls_1; O : PO_T1; R : Integer; begin Report.Test ("CY30033", "Interface types (AI-345 and AI-399)"); Report.Comment ("Check direct calls"); Prim1_1 (O); -- Check direct calls Prim1_2 (O, 10); R := Prim2_1 (O); R := Prim2_2 (O, 10); Report.Comment ("Check dispatching calls"); Dispatch_Calls_1 (O); -- Check dispatching calls Report.Result; end cy30037;