-- C390003.A
|
-- C390003.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- OBJECTIVE:
|
-- OBJECTIVE:
|
-- Check that for a subtype S of a tagged type T, S'Class denotes a
|
-- Check that for a subtype S of a tagged type T, S'Class denotes a
|
-- class-wide subtype. Check that T'Tag denotes the tag of the type T,
|
-- class-wide subtype. Check that T'Tag denotes the tag of the type T,
|
-- and that, for a class-wide tagged type X, X'Tag denotes the tag of X.
|
-- and that, for a class-wide tagged type X, X'Tag denotes the tag of X.
|
-- Check that the tags of stand alone objects, record and array
|
-- Check that the tags of stand alone objects, record and array
|
-- components, aggregates, and formal parameters identify their type.
|
-- components, aggregates, and formal parameters identify their type.
|
-- Check that the tag of a value of a formal parameter is that of the
|
-- Check that the tag of a value of a formal parameter is that of the
|
-- actual parameter, even if the actual is passed by a view conversion.
|
-- actual parameter, even if the actual is passed by a view conversion.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test defines a class hierarchy (based on C390002) and
|
-- This test defines a class hierarchy (based on C390002) and
|
-- uses it to determine the correctness of the resulting tag
|
-- uses it to determine the correctness of the resulting tag
|
-- information generated by the compiler. A type is defined in the
|
-- information generated by the compiler. A type is defined in the
|
-- class which contains components of the class as part of its
|
-- class which contains components of the class as part of its
|
-- definition. This is to reduce the overall number of types
|
-- definition. This is to reduce the overall number of types
|
-- required, and to achieve the required nesting to accomplish
|
-- required, and to achieve the required nesting to accomplish
|
-- this test. The model is that of a car carrier truck; both car
|
-- this test. The model is that of a car carrier truck; both car
|
-- and truck being in the class of Vehicle.
|
-- and truck being in the class of Vehicle.
|
--
|
--
|
-- Class Hierarchy:
|
-- Class Hierarchy:
|
-- Vehicle - - - - - - - (Bicycle)
|
-- Vehicle - - - - - - - (Bicycle)
|
-- / | \ / \
|
-- / | \ / \
|
-- Truck Car Q_Machine Tandem Motorcycle
|
-- Truck Car Q_Machine Tandem Motorcycle
|
-- |
|
-- |
|
-- Auto_Carrier
|
-- Auto_Carrier
|
-- Contains:
|
-- Contains:
|
-- Auto_Carrier( Car )
|
-- Auto_Carrier( Car )
|
-- Q_Machine( Car, Motorcycle )
|
-- Q_Machine( Car, Motorcycle )
|
--
|
--
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 19 Dec 94 SAIC Removed ARM references from objective text.
|
-- 19 Dec 94 SAIC Removed ARM references from objective text.
|
-- 20 Dec 94 SAIC Replaced three unnecessary extension
|
-- 20 Dec 94 SAIC Replaced three unnecessary extension
|
-- aggregates with simple aggregates.
|
-- aggregates with simple aggregates.
|
-- 16 Oct 95 SAIC Fixed bugs for ACVC 2.0.1
|
-- 16 Oct 95 SAIC Fixed bugs for ACVC 2.0.1
|
--
|
--
|
--!
|
--!
|
|
|
----------------------------------------------------------------- C390003_1
|
----------------------------------------------------------------- C390003_1
|
|
|
with Ada.Tags;
|
with Ada.Tags;
|
package C390003_1 is -- Vehicle
|
package C390003_1 is -- Vehicle
|
|
|
type TC_Keys is (Veh, MC, Tand, Car, Q, Truk, Heavy);
|
type TC_Keys is (Veh, MC, Tand, Car, Q, Truk, Heavy);
|
type States is (Good, Flat, Worn);
|
type States is (Good, Flat, Worn);
|
|
|
type Wheel_List is array(Positive range <>) of States;
|
type Wheel_List is array(Positive range <>) of States;
|
|
|
type Object(Wheels: Positive) is tagged record
|
type Object(Wheels: Positive) is tagged record
|
Wheel_State : Wheel_List(1..Wheels);
|
Wheel_State : Wheel_List(1..Wheels);
|
end record;
|
end record;
|
|
|
procedure TC_Validate( It: Object; Key: TC_Keys );
|
procedure TC_Validate( It: Object; Key: TC_Keys );
|
procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag );
|
procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag );
|
|
|
procedure Create( The_Vehicle : in out Object; Tyres : in States );
|
procedure Create( The_Vehicle : in out Object; Tyres : in States );
|
procedure Rotate( The_Vehicle : in out Object );
|
procedure Rotate( The_Vehicle : in out Object );
|
function Wheels( The_Vehicle : Object ) return Positive;
|
function Wheels( The_Vehicle : Object ) return Positive;
|
|
|
end C390003_1; -- Vehicle;
|
end C390003_1; -- Vehicle;
|
|
|
----------------------------------------------------------------- C390003_2
|
----------------------------------------------------------------- C390003_2
|
|
|
with C390003_1;
|
with C390003_1;
|
package C390003_2 is -- Motivators
|
package C390003_2 is -- Motivators
|
|
|
package Vehicle renames C390003_1;
|
package Vehicle renames C390003_1;
|
subtype Bicycle is Vehicle.Object(2); -- constrained subtype
|
subtype Bicycle is Vehicle.Object(2); -- constrained subtype
|
|
|
type Motorcycle is new Bicycle with record
|
type Motorcycle is new Bicycle with record
|
Displacement : Natural;
|
Displacement : Natural;
|
end record;
|
end record;
|
procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys );
|
procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys );
|
|
|
type Tandem is new Bicycle with null record;
|
type Tandem is new Bicycle with null record;
|
procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys );
|
procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys );
|
|
|
type Car is new Vehicle.Object(4) with -- extended, constrained
|
type Car is new Vehicle.Object(4) with -- extended, constrained
|
record
|
record
|
Displacement : Natural;
|
Displacement : Natural;
|
end record;
|
end record;
|
procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys );
|
procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys );
|
|
|
type Truck is new Vehicle.Object with -- extended, unconstrained
|
type Truck is new Vehicle.Object with -- extended, unconstrained
|
record
|
record
|
Tare : Natural;
|
Tare : Natural;
|
end record;
|
end record;
|
procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys );
|
procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys );
|
|
|
end C390003_2; -- Motivators;
|
end C390003_2; -- Motivators;
|
|
|
----------------------------------------------------------------- C390003_3
|
----------------------------------------------------------------- C390003_3
|
|
|
with C390003_1;
|
with C390003_1;
|
with C390003_2;
|
with C390003_2;
|
package C390003_3 is -- Special_Trucks
|
package C390003_3 is -- Special_Trucks
|
package Vehicle renames C390003_1;
|
package Vehicle renames C390003_1;
|
package Motivators renames C390003_2;
|
package Motivators renames C390003_2;
|
Max_Cars_On_Vehicle : constant := 6;
|
Max_Cars_On_Vehicle : constant := 6;
|
type Cargo_Index is range 0..Max_Cars_On_Vehicle;
|
type Cargo_Index is range 0..Max_Cars_On_Vehicle;
|
type Cargo is array(Cargo_Index range 1..Max_Cars_On_Vehicle)
|
type Cargo is array(Cargo_Index range 1..Max_Cars_On_Vehicle)
|
of Motivators.Car;
|
of Motivators.Car;
|
type Auto_Carrier is new Motivators.Truck(18) with
|
type Auto_Carrier is new Motivators.Truck(18) with
|
record
|
record
|
Load_Count : Cargo_Index := 0;
|
Load_Count : Cargo_Index := 0;
|
Payload : Cargo;
|
Payload : Cargo;
|
end record;
|
end record;
|
procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys );
|
procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys );
|
procedure Load ( The_Car : in Motivators.Car;
|
procedure Load ( The_Car : in Motivators.Car;
|
Onto : in out Auto_Carrier);
|
Onto : in out Auto_Carrier);
|
procedure Unload( The_Car : out Motivators.Car;
|
procedure Unload( The_Car : out Motivators.Car;
|
Off_of : in out Auto_Carrier);
|
Off_of : in out Auto_Carrier);
|
end C390003_3;
|
end C390003_3;
|
|
|
----------------------------------------------------------------- C390003_4
|
----------------------------------------------------------------- C390003_4
|
|
|
with C390003_1;
|
with C390003_1;
|
with C390003_2;
|
with C390003_2;
|
package C390003_4 is -- James_Bond
|
package C390003_4 is -- James_Bond
|
|
|
package Vehicle renames C390003_1;
|
package Vehicle renames C390003_1;
|
package Motivators renames C390003_2;
|
package Motivators renames C390003_2;
|
|
|
type Q_Machine is new Vehicle.Object(4) with record
|
type Q_Machine is new Vehicle.Object(4) with record
|
Car_Part : Motivators.Car;
|
Car_Part : Motivators.Car;
|
Bike_Part : Motivators.Motorcycle;
|
Bike_Part : Motivators.Motorcycle;
|
end record;
|
end record;
|
procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys );
|
procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys );
|
|
|
end C390003_4;
|
end C390003_4;
|
|
|
----------------------------------------------------------------- C390003_1
|
----------------------------------------------------------------- C390003_1
|
|
|
with Report;
|
with Report;
|
with Ada.Tags;
|
with Ada.Tags;
|
package body C390003_1 is -- Vehicle
|
package body C390003_1 is -- Vehicle
|
|
|
function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
|
function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
|
|
|
procedure TC_Validate( It: Object; Key: TC_Keys ) is
|
procedure TC_Validate( It: Object; Key: TC_Keys ) is
|
begin
|
begin
|
if Key /= Veh then
|
if Key /= Veh then
|
Report.Failed("Expected Veh Key");
|
Report.Failed("Expected Veh Key");
|
end if;
|
end if;
|
end TC_Validate;
|
end TC_Validate;
|
|
|
procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag ) is
|
procedure TC_Validate( It: Object'Class; The_Tag: Ada.Tags.Tag ) is
|
begin
|
begin
|
if It'Tag /= The_Tag then
|
if It'Tag /= The_Tag then
|
Report.Failed("Unexpected Tag for classwide formal");
|
Report.Failed("Unexpected Tag for classwide formal");
|
end if;
|
end if;
|
end TC_Validate;
|
end TC_Validate;
|
|
|
procedure Create( The_Vehicle : in out Object; Tyres : in States ) is
|
procedure Create( The_Vehicle : in out Object; Tyres : in States ) is
|
begin
|
begin
|
The_Vehicle.Wheel_State := ( others => Tyres );
|
The_Vehicle.Wheel_State := ( others => Tyres );
|
end Create;
|
end Create;
|
|
|
function Wheels( The_Vehicle : Object ) return Positive is
|
function Wheels( The_Vehicle : Object ) return Positive is
|
begin
|
begin
|
return The_Vehicle.Wheels;
|
return The_Vehicle.Wheels;
|
end Wheels;
|
end Wheels;
|
|
|
procedure Rotate( The_Vehicle : in out Object ) is
|
procedure Rotate( The_Vehicle : in out Object ) is
|
Push : States;
|
Push : States;
|
Pulled : States
|
Pulled : States
|
:= The_Vehicle.Wheel_State(The_Vehicle.Wheel_State'Last);
|
:= The_Vehicle.Wheel_State(The_Vehicle.Wheel_State'Last);
|
begin
|
begin
|
for Finger in
|
for Finger in
|
The_Vehicle.Wheel_State'First..The_Vehicle.Wheel_State'Last loop
|
The_Vehicle.Wheel_State'First..The_Vehicle.Wheel_State'Last loop
|
Push := The_Vehicle.Wheel_State(Finger);
|
Push := The_Vehicle.Wheel_State(Finger);
|
The_Vehicle.Wheel_State(Finger) := Pulled;
|
The_Vehicle.Wheel_State(Finger) := Pulled;
|
Pulled := Push;
|
Pulled := Push;
|
end loop;
|
end loop;
|
end Rotate;
|
end Rotate;
|
|
|
end C390003_1; -- Vehicle;
|
end C390003_1; -- Vehicle;
|
|
|
----------------------------------------------------------------- C390003_2
|
----------------------------------------------------------------- C390003_2
|
|
|
with Ada.Tags;
|
with Ada.Tags;
|
with Report;
|
with Report;
|
package body C390003_2 is -- Motivators
|
package body C390003_2 is -- Motivators
|
|
|
function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
|
function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
|
function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
|
function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
|
|
|
procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys ) is
|
procedure TC_Validate( It: Motorcycle; Key: Vehicle.TC_Keys ) is
|
begin
|
begin
|
if Key /= Vehicle.MC then
|
if Key /= Vehicle.MC then
|
Report.Failed("Expected MC Key");
|
Report.Failed("Expected MC Key");
|
end if;
|
end if;
|
end TC_Validate;
|
end TC_Validate;
|
|
|
procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys ) is
|
procedure TC_Validate( It: Tandem; Key: Vehicle.TC_Keys ) is
|
begin
|
begin
|
if Key /= Vehicle.Tand then
|
if Key /= Vehicle.Tand then
|
Report.Failed("Expected Tand Key");
|
Report.Failed("Expected Tand Key");
|
end if;
|
end if;
|
end TC_Validate;
|
end TC_Validate;
|
|
|
procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys ) is
|
procedure TC_Validate( It: Car; Key: Vehicle.TC_Keys ) is
|
begin
|
begin
|
if Key /= Vehicle.Car then
|
if Key /= Vehicle.Car then
|
Report.Failed("Expected Car Key");
|
Report.Failed("Expected Car Key");
|
end if;
|
end if;
|
end TC_Validate;
|
end TC_Validate;
|
|
|
procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys ) is
|
procedure TC_Validate( It: Truck; Key: Vehicle.TC_Keys ) is
|
begin
|
begin
|
if Key /= Vehicle.Truk then
|
if Key /= Vehicle.Truk then
|
Report.Failed("Expected Truk Key");
|
Report.Failed("Expected Truk Key");
|
end if;
|
end if;
|
end TC_Validate;
|
end TC_Validate;
|
end C390003_2; -- Motivators;
|
end C390003_2; -- Motivators;
|
|
|
----------------------------------------------------------------- C390003_3
|
----------------------------------------------------------------- C390003_3
|
|
|
with Ada.Tags;
|
with Ada.Tags;
|
with Report;
|
with Report;
|
package body C390003_3 is -- Special_Trucks
|
package body C390003_3 is -- Special_Trucks
|
|
|
function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
|
function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
|
function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
|
function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
|
|
|
procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys ) is
|
procedure TC_Validate( It: Auto_Carrier; Key: Vehicle.TC_Keys ) is
|
begin
|
begin
|
if Key /= Vehicle.Heavy then
|
if Key /= Vehicle.Heavy then
|
Report.Failed("Expected Heavy Key");
|
Report.Failed("Expected Heavy Key");
|
end if;
|
end if;
|
end TC_Validate;
|
end TC_Validate;
|
|
|
procedure Load ( The_Car : in Motivators.Car;
|
procedure Load ( The_Car : in Motivators.Car;
|
Onto : in out Auto_Carrier) is
|
Onto : in out Auto_Carrier) is
|
begin
|
begin
|
Onto.Load_Count := Onto.Load_Count +1;
|
Onto.Load_Count := Onto.Load_Count +1;
|
Onto.Payload(Onto.Load_Count) := The_Car;
|
Onto.Payload(Onto.Load_Count) := The_Car;
|
end Load;
|
end Load;
|
procedure Unload( The_Car : out Motivators.Car;
|
procedure Unload( The_Car : out Motivators.Car;
|
Off_of : in out Auto_Carrier) is
|
Off_of : in out Auto_Carrier) is
|
begin
|
begin
|
The_Car := Off_of.Payload(Off_of.Load_Count);
|
The_Car := Off_of.Payload(Off_of.Load_Count);
|
Off_of.Load_Count := Off_of.Load_Count -1;
|
Off_of.Load_Count := Off_of.Load_Count -1;
|
end Unload;
|
end Unload;
|
|
|
end C390003_3;
|
end C390003_3;
|
|
|
----------------------------------------------------------------- C390003_4
|
----------------------------------------------------------------- C390003_4
|
|
|
with Report, Ada.Tags;
|
with Report, Ada.Tags;
|
package body C390003_4 is -- James_Bond
|
package body C390003_4 is -- James_Bond
|
|
|
function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
|
function "="(A,B: Ada.Tags.Tag) return Boolean renames Ada.Tags."=";
|
function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
|
function "="(A,B: Vehicle.TC_Keys) return Boolean renames Vehicle."=";
|
|
|
procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys ) is
|
procedure TC_Validate( It: Q_Machine; Key: Vehicle.TC_Keys ) is
|
begin
|
begin
|
if Key /= Vehicle.Q then
|
if Key /= Vehicle.Q then
|
Report.Failed("Expected Q Key");
|
Report.Failed("Expected Q Key");
|
end if;
|
end if;
|
end TC_Validate;
|
end TC_Validate;
|
|
|
end C390003_4;
|
end C390003_4;
|
|
|
------------------------------------------------------------------- C390003
|
------------------------------------------------------------------- C390003
|
|
|
with Report;
|
with Report;
|
with C390003_1;
|
with C390003_1;
|
with C390003_2;
|
with C390003_2;
|
with C390003_3;
|
with C390003_3;
|
with C390003_4;
|
with C390003_4;
|
procedure C390003 is
|
procedure C390003 is
|
|
|
package Vehicle renames C390003_1; use Vehicle;
|
package Vehicle renames C390003_1; use Vehicle;
|
package Motivators renames C390003_2;
|
package Motivators renames C390003_2;
|
package Special_Trucks renames C390003_3;
|
package Special_Trucks renames C390003_3;
|
package James_Bond renames C390003_4;
|
package James_Bond renames C390003_4;
|
|
|
-- The cast, in order of complexity:
|
-- The cast, in order of complexity:
|
|
|
Pennys_Bike : Motivators.Bicycle;
|
Pennys_Bike : Motivators.Bicycle;
|
Weekender : Motivators.Tandem;
|
Weekender : Motivators.Tandem;
|
Qs_Moped : Motivators.Motorcycle;
|
Qs_Moped : Motivators.Motorcycle;
|
Ms_Limo : Motivators.Car;
|
Ms_Limo : Motivators.Car;
|
Yard_Van : Motivators.Truck(8);
|
Yard_Van : Motivators.Truck(8);
|
Specter_X : Special_Trucks.Auto_Carrier;
|
Specter_X : Special_Trucks.Auto_Carrier;
|
Gen_II : James_Bond.Q_Machine;
|
Gen_II : James_Bond.Q_Machine;
|
|
|
|
|
-- Check compatibility with the corresponding class wide type.
|
-- Check compatibility with the corresponding class wide type.
|
|
|
procedure Vehicle_Shop( It : in out Vehicle.Object'Class;
|
procedure Vehicle_Shop( It : in out Vehicle.Object'Class;
|
Key : in Vehicle.TC_Keys ) is
|
Key : in Vehicle.TC_Keys ) is
|
|
|
-- Check that Subtype'Class is defined for tagged subtypes.
|
-- Check that Subtype'Class is defined for tagged subtypes.
|
procedure Bike_Shop( Bike: in out Motivators.Bicycle'Class ) is
|
procedure Bike_Shop( Bike: in out Motivators.Bicycle'Class ) is
|
begin
|
begin
|
-- Dispatch to appropriate TC_Validate
|
-- Dispatch to appropriate TC_Validate
|
Vehicle.TC_Validate( Bike, Key );
|
Vehicle.TC_Validate( Bike, Key );
|
end Bike_Shop;
|
end Bike_Shop;
|
|
|
begin
|
begin
|
Vehicle.TC_Validate( It, Key );
|
Vehicle.TC_Validate( It, Key );
|
if Vehicle.Wheels( It ) = 2 then
|
if Vehicle.Wheels( It ) = 2 then
|
Bike_Shop( It ); -- only call Bike_Shop when It has 2 wheels
|
Bike_Shop( It ); -- only call Bike_Shop when It has 2 wheels
|
end if;
|
end if;
|
end Vehicle_Shop;
|
end Vehicle_Shop;
|
|
|
begin -- Main test procedure.
|
begin -- Main test procedure.
|
|
|
Report.Test ("C390003", "Check that for a subtype S of a tagged type " &
|
Report.Test ("C390003", "Check that for a subtype S of a tagged type " &
|
"T, S'Class denotes a class-wide subtype. Check that " &
|
"T, S'Class denotes a class-wide subtype. Check that " &
|
"T'Tag denotes the tag of the type T, and that, for a " &
|
"T'Tag denotes the tag of the type T, and that, for a " &
|
"class-wide tagged type X, X'Tag denotes the tag of X. " &
|
"class-wide tagged type X, X'Tag denotes the tag of X. " &
|
"Check that the tags of stand alone objects, record and " &
|
"Check that the tags of stand alone objects, record and " &
|
"array components, aggregates, and formal parameters " &
|
"array components, aggregates, and formal parameters " &
|
"identify their type. Check that the tag of a value of a " &
|
"identify their type. Check that the tag of a value of a " &
|
"formal parameter is that of the actual parameter, even " &
|
"formal parameter is that of the actual parameter, even " &
|
"if the actual is passed by a view conversion" );
|
"if the actual is passed by a view conversion" );
|
|
|
-- Check that the tags of stand alone objects, record and array
|
-- Check that the tags of stand alone objects, record and array
|
-- components, aggregates, and formal parameters identify their type.
|
-- components, aggregates, and formal parameters identify their type.
|
-- Check that the tag of a value of a formal parameter is that of the
|
-- Check that the tag of a value of a formal parameter is that of the
|
-- actual parameter, even if the actual is passed by a view conversion.
|
-- actual parameter, even if the actual is passed by a view conversion.
|
|
|
Vehicle_Shop( Pennys_Bike, Veh );
|
Vehicle_Shop( Pennys_Bike, Veh );
|
Vehicle_Shop( Weekender, Tand );
|
Vehicle_Shop( Weekender, Tand );
|
Vehicle_Shop( Qs_Moped, MC );
|
Vehicle_Shop( Qs_Moped, MC );
|
Vehicle_Shop( Ms_Limo, Car );
|
Vehicle_Shop( Ms_Limo, Car );
|
Vehicle_Shop( Yard_Van, Truk );
|
Vehicle_Shop( Yard_Van, Truk );
|
Vehicle_Shop( Specter_X, Heavy );
|
Vehicle_Shop( Specter_X, Heavy );
|
Vehicle_Shop( Specter_X.Payload(1), Car );
|
Vehicle_Shop( Specter_X.Payload(1), Car );
|
Vehicle_Shop( Gen_II, Q );
|
Vehicle_Shop( Gen_II, Q );
|
Vehicle_Shop( Gen_II.Car_Part, Car );
|
Vehicle_Shop( Gen_II.Car_Part, Car );
|
Vehicle_Shop( Gen_II.Bike_Part, MC );
|
Vehicle_Shop( Gen_II.Bike_Part, MC );
|
|
|
Vehicle.TC_Validate( Pennys_Bike, Vehicle.Object'Tag );
|
Vehicle.TC_Validate( Pennys_Bike, Vehicle.Object'Tag );
|
Vehicle.TC_Validate( Weekender, Motivators.Tandem'Tag );
|
Vehicle.TC_Validate( Weekender, Motivators.Tandem'Tag );
|
Vehicle.TC_Validate( Qs_Moped, Motivators.Motorcycle'Tag );
|
Vehicle.TC_Validate( Qs_Moped, Motivators.Motorcycle'Tag );
|
Vehicle.TC_Validate( Ms_Limo, Motivators.Car'Tag );
|
Vehicle.TC_Validate( Ms_Limo, Motivators.Car'Tag );
|
Vehicle.TC_Validate( Yard_Van, Motivators.Truck'Tag );
|
Vehicle.TC_Validate( Yard_Van, Motivators.Truck'Tag );
|
Vehicle.TC_Validate( Specter_X, Special_Trucks.Auto_Carrier'Tag );
|
Vehicle.TC_Validate( Specter_X, Special_Trucks.Auto_Carrier'Tag );
|
Vehicle.TC_Validate( Specter_X.Payload(1), Motivators.Car'Tag );
|
Vehicle.TC_Validate( Specter_X.Payload(1), Motivators.Car'Tag );
|
Vehicle.TC_Validate( Gen_II, James_Bond.Q_Machine'Tag );
|
Vehicle.TC_Validate( Gen_II, James_Bond.Q_Machine'Tag );
|
Vehicle.TC_Validate( Gen_II.Car_Part, Motivators.Car'Tag );
|
Vehicle.TC_Validate( Gen_II.Car_Part, Motivators.Car'Tag );
|
Vehicle.TC_Validate( Gen_II.Bike_Part, Motivators.Motorcycle'Tag );
|
Vehicle.TC_Validate( Gen_II.Bike_Part, Motivators.Motorcycle'Tag );
|
|
|
-- Check the tag generated for an aggregate.
|
-- Check the tag generated for an aggregate.
|
|
|
Rentals: declare
|
Rentals: declare
|
Mikes_Rental : Vehicle.Object'Class :=
|
Mikes_Rental : Vehicle.Object'Class :=
|
Vehicle.Object'( 3, (Good, Flat, Worn));
|
Vehicle.Object'( 3, (Good, Flat, Worn));
|
Diannes_Car : Vehicle.Object'Class :=
|
Diannes_Car : Vehicle.Object'Class :=
|
Motivators.Tandem'( Wheels => 2,
|
Motivators.Tandem'( Wheels => 2,
|
Wheel_State => (Good, Good) );
|
Wheel_State => (Good, Good) );
|
Jims_Bike : Vehicle.Object'Class :=
|
Jims_Bike : Vehicle.Object'Class :=
|
Motivators.Motorcycle'( Pennys_Bike
|
Motivators.Motorcycle'( Pennys_Bike
|
with Displacement => 350 );
|
with Displacement => 350 );
|
Bills_Limo : Vehicle.Object'Class :=
|
Bills_Limo : Vehicle.Object'Class :=
|
Motivators.Car'( Wheels => 4,
|
Motivators.Car'( Wheels => 4,
|
Wheel_State => (others => Good),
|
Wheel_State => (others => Good),
|
Displacement => 282 );
|
Displacement => 282 );
|
Alans_Car : Vehicle.Object'Class :=
|
Alans_Car : Vehicle.Object'Class :=
|
Motivators.Truck'( 18, (others => Worn),
|
Motivators.Truck'( 18, (others => Worn),
|
Tare => 5_500 );
|
Tare => 5_500 );
|
Pats_Truck : Vehicle.Object'Class := Specter_X;
|
Pats_Truck : Vehicle.Object'Class := Specter_X;
|
Keiths_Car : Vehicle.Object'Class := Gen_II;
|
Keiths_Car : Vehicle.Object'Class := Gen_II;
|
Isaacs_Bus : Vehicle.Object'Class := Keiths_Car;
|
Isaacs_Bus : Vehicle.Object'Class := Keiths_Car;
|
|
|
begin
|
begin
|
Vehicle.TC_Validate( Mikes_Rental, Vehicle.Object'Tag );
|
Vehicle.TC_Validate( Mikes_Rental, Vehicle.Object'Tag );
|
Vehicle.TC_Validate( Diannes_Car, Motivators.Tandem'Tag );
|
Vehicle.TC_Validate( Diannes_Car, Motivators.Tandem'Tag );
|
Vehicle.TC_Validate( Jims_Bike, Motivators.Motorcycle'Tag );
|
Vehicle.TC_Validate( Jims_Bike, Motivators.Motorcycle'Tag );
|
Vehicle.TC_Validate( Bills_Limo, Motivators.Car'Tag );
|
Vehicle.TC_Validate( Bills_Limo, Motivators.Car'Tag );
|
Vehicle.TC_Validate( Alans_Car, Motivators.Truck'Tag );
|
Vehicle.TC_Validate( Alans_Car, Motivators.Truck'Tag );
|
Vehicle.TC_Validate( Pats_Truck, Special_Trucks.Auto_Carrier'Tag );
|
Vehicle.TC_Validate( Pats_Truck, Special_Trucks.Auto_Carrier'Tag );
|
Vehicle.TC_Validate( Keiths_Car, James_Bond.Q_Machine'Tag );
|
Vehicle.TC_Validate( Keiths_Car, James_Bond.Q_Machine'Tag );
|
end Rentals;
|
end Rentals;
|
|
|
-- Check the tag of parameters.
|
-- Check the tag of parameters.
|
-- Check that the tag is not affected by view conversion.
|
-- Check that the tag is not affected by view conversion.
|
|
|
Vehicle.TC_Validate( Vehicle.Object( Gen_II ), James_Bond.Q_Machine'Tag );
|
Vehicle.TC_Validate( Vehicle.Object( Gen_II ), James_Bond.Q_Machine'Tag );
|
Vehicle.TC_Validate( Vehicle.Object( Ms_Limo ), Motivators.Car'Tag );
|
Vehicle.TC_Validate( Vehicle.Object( Ms_Limo ), Motivators.Car'Tag );
|
Vehicle.TC_Validate( Motivators.Bicycle( Weekender ),
|
Vehicle.TC_Validate( Motivators.Bicycle( Weekender ),
|
Motivators.Tandem'Tag );
|
Motivators.Tandem'Tag );
|
Vehicle.TC_Validate( Motivators.Bicycle( Gen_II.Bike_Part ),
|
Vehicle.TC_Validate( Motivators.Bicycle( Gen_II.Bike_Part ),
|
Motivators.Motorcycle'Tag );
|
Motivators.Motorcycle'Tag );
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C390003;
|
end C390003;
|
|
|
