-- by30013.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: -- Hristian Kirtchev -- -- OBJECTIVE: -- Check AI-251, 345 (interfaces with generics) -- -- CHANGE HISTORY: -- 28 March 2005 Initial Version -- 05 April 2005 Augmentation --! procedure BY30013 is package PkgI1 is ------------------------------ -- Interface declarations -- ------------------------------ type TI1 is task interface; procedure P (A : in out TI1) is abstract; type TI2 is task interface; procedure Q (B : in out TI2) is abstract; type PI1 is protected interface; procedure R (C : in out PI1) is abstract; type PI2 is protected interface; procedure S (D : in out PI2) is abstract; type SI1 is synchronized interface; procedure T (E : in out SI1) is abstract; type SI2 is synchronized interface; procedure U (F : in out SI2) is abstract; type I1 is interface; procedure V (G : in out I1) is abstract; type I2 is interface; procedure W (H : in out I2) is abstract; type LI1 is limited interface; procedure X (I : in out LI1) is abstract; type LI2 is limited interface; procedure Y (J : in out LI2) is abstract; --------------------------------- -- Interface implementations -- --------------------------------- task type Task_TI1 is new TI1 with entry P; end Task_TI1; task type Task_TI2 is new TI2 with entry Q; end Task_TI2; protected type Protected_PI1 is new PI1 with entry R; end Protected_PI1; protected type Protected_PI2 is new PI2 with entry S; end Protected_PI2; task type Synchronized_SI1 is new SI1 with entry T; end Synchronized_SI1; protected type Synchronized_SI2 is new SI2 with entry U; end Synchronized_SI2; type Object_I1 is new I1 with null record; procedure V (G : in out Object_I1); type Object_I2 is new I2 with null record; procedure W (H : in out Object_I2); end PkgI1; package body PkgI1 is ----------------------------- -- Implementation bodies -- ----------------------------- task body Task_TI1 is begin accept P do null; end P; end Task_TI1; task body Task_TI2 is begin accept Q do null; end Q; end Task_TI2; protected body Protected_PI1 is entry R when True is begin null; end R; end Protected_PI1; protected body Protected_PI2 is entry S when True is begin null; end S; end Protected_PI2; task body Synchronized_SI1 is begin accept T do null; end T; end Synchronized_SI1; protected body Synchronized_SI2 is entry U when True is begin null; end U; end Synchronized_SI2; procedure V (G : in out Object_I1) is begin null; end V; procedure W (H : in out Object_I2) is begin null; end W; end PkgI1; use PkgI1; --------------------------- -- Generic Declaration -- --------------------------- -- with task interface generic type Generic_TI1 is new TI1 with private; package Package_TI1 is procedure Call_TI1_P (Obj : in out Generic_TI1); end Package_TI1; package body Package_TI1 is procedure Call_TI1_P (Obj : in out Generic_TI1) is begin Obj.P; end Call_TI1_P; end Package_TI1; -- with protected interface generic type Generic_PI1 is new PI1 with private; package Package_PI1 is procedure Call_PI1_R (Obj : in out Generic_PI1); end Package_PI1; package body Package_PI1 is procedure Call_PI1_R (Obj : in out Generic_PI1) is begin Obj.R; end Call_PI1_R; end Package_PI1; -- with synchronized interface generic type Generic_SI1 is new SI1 with private; package Package_SI1 is procedure Call_SI1_T (Obj : in out Generic_SI1); end Package_SI1; package body Package_SI1 is procedure Call_SI1_T (Obj : in out Generic_SI1) is begin Obj.T; end Call_SI1_T; end Package_SI1; -- with non-limited interface generic type Generic_I1 is new I1 with private; package Package_I1 is procedure Call_I1_V (Obj : in out Generic_I1); end Package_I1; package body Package_I1 is procedure Call_I1_V (Obj : in out Generic_I1) is begin Obj.V; end Call_I1_V; end Package_I1; ------------------------------ -- Generic Instantiations -- ------------------------------ -- tasks -- ------------------------------------------------------------------------ package Pkg02 is new Package_TI1 (Task_TI1); -- OK -- ------------------------------------------------------------------------ package Pkg03 is new Package_TI1 (Task_TI2); -- ERROR -- Reason: Task_TI2 is not an implementation of TI1 -- ------------------------------------------------------------------------ package Pkg04 is new Package_TI1 (Protected_PI1); -- ERROR -- Reason: Protected_PI1 is not an implementation of TI1 -- ------------------------------------------------------------------------ package Pkg05 is new Package_TI1 (Synchronized_SI1); -- ERROR -- Reason: Synchronized_SI1 is not an implementation of TI1 -- ------------------------------------------------------------------------ package Pkg06 is new Package_TI1 (Object_I1); -- ERROR -- Reason: Object_I1 is not an implementation of TI1 -- ------------------------------------------------------------------------ -- protected -- ------------------------------------------------------------------------ package Pkg07 is new Package_PI1 (Task_TI1); -- ERROR -- Reason: Task_TI1 is not an implementation of PI1 -- ------------------------------------------------------------------------ package Pkg08 is new Package_PI1 (Protected_PI1); -- OK -- ------------------------------------------------------------------------ package Pkg09 is new Package_PI1 (Protected_PI2); -- ERROR -- Reason: Protected_PI2 is not an implementation of PI1 ---------------------------------------------------------------------------- package Pkg10 is new Package_PI1 (Synchronized_SI1); -- ERROR -- Reason: Synchronized_SI1 is not an implementation of PI1 -- ------------------------------------------------------------------------ package Pkg11 is new Package_PI1 (Object_I1); -- ERROR -- Reason: Object_I1 is not an implementation of PI1 -- ------------------------------------------------------------------------ -- synchronized -- ------------------------------------------------------------------------ package Pkg12 is new Package_SI1 (Task_TI1); -- ERROR -- Reason: Task_TI1 is not an implementation of SI1 -- ------------------------------------------------------------------------ package Pkg13 is new Package_SI1 (Protected_PI1); -- ERROR -- Reason: Protected_PI1 is not an implementation of SI1 -- ------------------------------------------------------------------------ package Pkg14 is new Package_SI1 (Synchronized_SI1); -- OK -- ------------------------------------------------------------------------ package Pkg15 is new Package_SI1 (Synchronized_SI2); -- ERROR -- Reason: Protected_SI2 is not an implementation of SI1 -- ------------------------------------------------------------------------ package Pkg16 is new Package_SI1 (Object_I1); -- ERROR -- Reason: Object_I1 is not an implementation of SI1 -- ------------------------------------------------------------------------ -- non-limited -- ------------------------------------------------------------------------ package Pkg17 is new Package_I1 (Task_TI1); -- ERROR -- Reason: Task_TI1 is not an implementation of I1 -- ------------------------------------------------------------------------ package Pkg18 is new Package_I1 (Protected_PI1); -- ERROR -- Reason: Protected_PI1 is not an implementation of I1 -- ------------------------------------------------------------------------ package Pkg19 is new Package_I1 (Synchronized_SI1); -- ERROR -- Reason: Synchronized_SI1 is not an implementation of I1 -- ------------------------------------------------------------------------ package Pkg20 is new Package_I1 (Object_I1); -- OK -- ------------------------------------------------------------------------ package Pkg21 is new Package_I1 (Object_I2); -- ERROR -- Reason: Object_I2 is not an implementation of I1 -- ------------------------------------------------------------------------ begin null; end BY30013;