| -- C392004.A |
| -- |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- 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. THE GOVERNMENT 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. |
| --* |
| -- |
| -- OBJECTIVE: |
| -- Check that subprograms inherited from tagged derivations, which are |
| -- subsequently redefined for the derived type, are available to the |
| -- package defining the new class via view conversion. Check |
| -- that operations performed on objects using view conversion do not |
| -- affect the extended fields. Check that visible operations not masked |
| -- by the deriving package remain available to the client, and do not |
| -- affect the extended fields. |
| -- |
| -- TEST DESCRIPTION: |
| -- This test declares a tagged type, with a constructor operation, |
| -- derives a type from that tagged type, and declares a constructor |
| -- operation which masks the inherited operation. It then tests |
| -- that the correct constructor is called, and that the extended |
| -- part of the derived type remains untouched as appropriate. |
| -- |
| -- |
| -- CHANGE HISTORY: |
| -- 06 Dec 94 SAIC ACVC 2.0 |
| -- 19 Dec 94 SAIC Removed RM references from objective text. |
| -- 04 Jan 94 SAIC Fixed objective typo, removed dead code. |
| -- |
| --! |
| |
| with Report; |
| |
| package C392004_1 is |
| |
| type Vehicle is tagged private; |
| |
| procedure Create ( The_Vehicle : out Vehicle; TC_Flag : Natural ); |
| procedure Start ( The_Vehicle : in out Vehicle ); |
| |
| private |
| |
| type Vehicle is tagged record |
| Engine_On : Boolean; |
| end record; |
| |
| end C392004_1; |
| |
| package body C392004_1 is |
| procedure Create ( The_Vehicle : out Vehicle; TC_Flag : Natural ) is |
| begin |
| case TC_Flag is |
| when 1 => null; -- expected flag for this subprogram |
| when others => |
| Report.Failed ("Called Vehicle Create"); |
| end case; |
| The_Vehicle := (Engine_On => False); |
| end Create; |
| |
| procedure Start ( The_Vehicle : in out Vehicle ) is |
| begin |
| The_Vehicle.Engine_On := True; |
| end Start; |
| |
| end C392004_1; |
| |
| ---------------------------------------------------------------------------- |
| |
| with C392004_1; |
| package C392004_2 is |
| |
| type Car is new C392004_1.Vehicle with record |
| Convertible : Boolean; |
| end record; |
| |
| -- masking definition |
| procedure Create( The_Car : out Car; TC_Flag : Natural ); |
| |
| type Limo is new Car with null record; |
| |
| procedure Create( The_Limo : out Limo; TC_Flag : Natural ); |
| |
| end C392004_2; |
| |
| ---------------------------------------------------------------------------- |
| |
| with Report; |
| package body C392004_2 is |
| |
| procedure Create( The_Car : out Car; TC_Flag : Natural ) is |
| begin |
| case TC_Flag is |
| when 2 => null; -- expected flag for this subprogram |
| when others => Report.Failed ("Called Car Create"); |
| end case; |
| C392004_1.Create( C392004_1.Vehicle(The_Car), 1); |
| The_Car.Convertible := False; |
| end Create; |
| |
| procedure Create( The_Limo : out Limo; TC_Flag : Natural ) is |
| begin |
| case TC_Flag is |
| when 3 => null; -- expected flag for this subprogram |
| when others => Report.Failed ("Called Limo Create"); |
| end case; |
| C392004_1.Create( C392004_1.Vehicle(The_Limo), 1); |
| The_Limo.Convertible := True; |
| end Create; |
| |
| end C392004_2; |
| |
| ---------------------------------------------------------------------------- |
| |
| with Report; |
| with C392004_1; use C392004_1; |
| with C392004_2; use C392004_2; |
| procedure C392004 is |
| |
| My_Car : Car; |
| Your_Car : Limo; |
| |
| procedure TC_Assert( Is_True : Boolean; Message : String ) is |
| begin |
| if not Is_True then |
| Report.Failed (Message); |
| end if; |
| end TC_Assert; |
| |
| begin -- Main test procedure. |
| |
| Report.Test ("C392004", "Check subprogram inheritance & visibility " & |
| "for derived tagged types" ); |
| |
| My_Car.Convertible := False; |
| Create( Vehicle( My_Car ), 1 ); |
| TC_Assert( not My_Car.Convertible, "Altered descendent component 1"); |
| |
| Create( Your_Car, 3 ); |
| TC_Assert( Your_Car.Convertible, "Did not set inherited component 2"); |
| |
| My_Car.Convertible := True; |
| Create( Vehicle( My_Car ), 1 ); |
| TC_Assert( My_Car.Convertible, "Altered descendent component 3"); |
| |
| Create( My_Car, 2 ); |
| TC_Assert( not My_Car.Convertible, "Did not set extending component 4"); |
| |
| My_Car.Convertible := False; |
| Start( Vehicle( My_Car ) ); |
| TC_Assert( not My_Car.Convertible , "Altered descendent component 5"); |
| |
| Start( My_Car ); |
| TC_Assert( not My_Car.Convertible, "Altered unreferenced component 6"); |
| |
| Your_Car.Convertible := False; |
| Start( Vehicle( Your_Car ) ); |
| TC_Assert( not Your_Car.Convertible , "Altered descendent component 7"); |
| |
| Start( Your_Car ); |
| TC_Assert( not Your_Car.Convertible, "Altered unreferenced component 8"); |
| |
| My_Car.Convertible := True; |
| Start( Vehicle( My_Car ) ); |
| TC_Assert( My_Car.Convertible, "Altered descendent component 9"); |
| |
| Start( My_Car ); |
| TC_Assert( My_Car.Convertible, "Altered unreferenced component 10"); |
| |
| Report.Result; |
| |
| end C392004; |