-- cy40014.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-252: Object.Operation Notation -- Check implicit dereference. Test based on the example described -- in AI-252.TXT -- -- CHANGE HISTORY: -- 16 JUL 2004 Initial Version --! package CY40014P is type TP is tagged record Value : Integer := 999; end record; procedure Set (X : in out TP); function Get (X : TP) return Integer; end CY40014P; package body CY40014P is procedure Set (X : in out TP) is begin X.Value := 10; end Set; function Get (X : TP) return Integer is begin return X.Value; end Get; end CY40014P; with CY40014P; package CY40014P3 is type T3 is new CY40014P.TP with record Id : Character := ' '; end record; procedure Set (A : access T3; Id : Character); end CY40014P3; package body CY40014P3 is procedure Set (A : access T3; Id : Character) is begin A.Id := Id; end Set; end CY40014P3; with CY40014P3; package CY40014P4 is type AT3 is access all CY40014P3.T3'Class; end CY40014P4; with Report; with CY40014P3, CY40014P4; procedure CY40014 is Ptr_1 : CY40014P4.AT3 := new CY40014P3.T3; Ptr_2 : CY40014P4.AT3 := new CY40014P3.T3; Ptr_3 : CY40014P4.AT3 := new CY40014P3.T3; V1, V2, V3 : Integer; begin Report.Test ("CY40012", "Object.Operation notation (allocators)"); -- Initialize the three allocated variables CY40014P3.Set (Ptr_1.all); -- Ada 95 Ptr_2.all.Set; -- Ada 2005 Ptr_3.Set; -- Ada 2005 -- Read its current value V1 := CY40014P3.Get (Ptr_1.all); -- Ada 95 V2 := Ptr_2.all.Get; -- Ada 2005 V3 := Ptr_3.Get; -- Ada 2005 -- Check these values if V1 /= V2 or V1 /= V3 then Report.Failed ("wrong value (visibility rule)"); end if; -- Call the new subprogram Ptr_1.Set (Id => 'x'); -- Ada 2005 Report.Result; end CY40014;