-- by30018.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 (single protected types covering interfaces) -- -- If an inherited subprogram is implemented by a protected procedure or -- an entry, then the first parameter of the inherited subprogram shall be -- of mode OUT or IN OUT, or an access-to-variable parameter. Therefore -- none of the protected types declared in this program cover the -- primitives of the interface. -- -- CHANGE HISTORY: -- 15 May 2005 Initial Version --! with Text_IO; use Text_IO; procedure by30018 is package pack is type Iface is task interface; procedure Prim1_1 (M : in Iface) is abstract; procedure Prim1_2 (M : in Iface; Value : Integer) is abstract; -- This protected type implements all the interface primitives by means -- of entries task type PO_T1 is new Iface with entry Prim1_1; entry Prim1_2 (Value : Integer); end PO_T1; -- This single PO implements all the interface primitives by -- means of entries task PO_Single_1 is new Iface with entry Prim1_1; entry Prim1_2 (Value : Integer); end PO_Single_1; end pack; package body Pack is task body PO_T1 is begin accept Prim1_1; accept Prim1_2 (Value : Integer); end PO_T1; task body PO_Single_1 is begin accept Prim1_1; accept Prim1_2 (Value : Integer); end PO_Single_1; end Pack; use Pack; procedure Dispatch_Calls_1 (X : out Iface'Class) is begin X.Prim1_1; X.Prim1_2 (10); end Dispatch_Calls_1; procedure Dispatch_Calls (X : in out Iface'Class) is begin X.Prim1_1; X.Prim1_2 (10); end Dispatch_Calls; procedure Dispatch_Calls (X : access Iface'Class) is begin X.Prim1_1; X.Prim1_2 (10); end Dispatch_Calls; begin null; end by30018;