-- C392C05.A
|
-- C392C05.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 call to a dispatching subprogram the subprogram
|
-- Check that for a call to a dispatching subprogram the subprogram
|
-- body which is executed is determined by the controlling tag for
|
-- body which is executed is determined by the controlling tag for
|
-- the case where the call has statically tagged controlling operands
|
-- the case where the call has statically tagged controlling operands
|
-- of the type T. Check this for various operands of tagged types:
|
-- of the type T. Check this for various operands of tagged types:
|
-- objects (declared or allocated), formal parameters, view conversions,
|
-- objects (declared or allocated), formal parameters, view conversions,
|
-- function calls (both primitive and non-primitive).
|
-- function calls (both primitive and non-primitive).
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- This test uses foundation F392C00 to test the usages of statically
|
-- This test uses foundation F392C00 to test the usages of statically
|
-- tagged objects and values. The calls to Validate indicate the
|
-- tagged objects and values. The calls to Validate indicate the
|
-- expected sequence of procedure calls since the previous call to
|
-- expected sequence of procedure calls since the previous call to
|
-- Validate. Static tags can be determined at compile time, and
|
-- Validate. Static tags can be determined at compile time, and
|
-- hence this is a test of correct overload resolution for tagged types.
|
-- hence this is a test of correct overload resolution for tagged types.
|
-- A clever compiler which unrolls loops and does path analysis on
|
-- A clever compiler which unrolls loops and does path analysis on
|
-- access values will be able to perform the same kind of determination
|
-- access values will be able to perform the same kind of determination
|
-- for all of the code in this test.
|
-- for all of the code in this test.
|
--
|
--
|
-- TEST FILES:
|
-- TEST FILES:
|
-- The following files comprise this test:
|
-- The following files comprise this test:
|
--
|
--
|
-- F392C00.A (foundation code)
|
-- F392C00.A (foundation code)
|
-- C392C05.A
|
-- C392C05.A
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 19 Dec 94 SAIC Removed RM references from objective text.
|
-- 19 Dec 94 SAIC Removed RM references from objective text.
|
-- 24 Oct 95 SAIC Updated for ACVC 2.0.1
|
-- 24 Oct 95 SAIC Updated for ACVC 2.0.1
|
-- 13 Feb 97 PWB.CTA Corrected assumption that "or" operands are
|
-- 13 Feb 97 PWB.CTA Corrected assumption that "or" operands are
|
-- evaluated in textual order.
|
-- evaluated in textual order.
|
--!
|
--!
|
|
|
with Report;
|
with Report;
|
with TCTouch;
|
with TCTouch;
|
with F392C00_1;
|
with F392C00_1;
|
procedure C392C05 is -- Hardware_Store
|
procedure C392C05 is -- Hardware_Store
|
|
|
package Switch renames F392C00_1;
|
package Switch renames F392C00_1;
|
|
|
subtype Switch_Class is Switch.Toggle'Class;
|
subtype Switch_Class is Switch.Toggle'Class;
|
|
|
type Reference is access all Switch_Class;
|
type Reference is access all Switch_Class;
|
|
|
A_Switch : aliased Switch.Toggle;
|
A_Switch : aliased Switch.Toggle;
|
A_Dimmer : aliased Switch.Dimmer;
|
A_Dimmer : aliased Switch.Dimmer;
|
An_Autodim : aliased Switch.Auto_Dimmer;
|
An_Autodim : aliased Switch.Auto_Dimmer;
|
|
|
type Light_Bank is array(Positive range <>) of Reference;
|
type Light_Bank is array(Positive range <>) of Reference;
|
|
|
Lamps : Light_Bank(1..3);
|
Lamps : Light_Bank(1..3);
|
|
|
begin -- Main test procedure.
|
begin -- Main test procedure.
|
|
|
Report.Test ("C392C05", "Check that a dispatching subprogram call is "
|
Report.Test ("C392C05", "Check that a dispatching subprogram call is "
|
& "determined by the controlling tag for statically "
|
& "determined by the controlling tag for statically "
|
& "tagged controlling operands" );
|
& "tagged controlling operands" );
|
|
|
-- Check use of static tagged declared objects,
|
-- Check use of static tagged declared objects,
|
-- and static tagged formal parameters
|
-- and static tagged formal parameters
|
-- Must call correct version of flip based on type of controlling op.
|
-- Must call correct version of flip based on type of controlling op.
|
|
|
-- Turn on the lights!
|
-- Turn on the lights!
|
|
|
Switch.Flip( A_Switch );
|
Switch.Flip( A_Switch );
|
TCTouch.Validate( "A", "Declared Toggle" );
|
TCTouch.Validate( "A", "Declared Toggle" );
|
|
|
Switch.Flip( A_Dimmer );
|
Switch.Flip( A_Dimmer );
|
TCTouch.Validate( "GBA", "Declared Dimmer" );
|
TCTouch.Validate( "GBA", "Declared Dimmer" );
|
|
|
Switch.Flip( An_Autodim );
|
Switch.Flip( An_Autodim );
|
TCTouch.Validate( "KGBA", "Declared Auto_Dimmer" );
|
TCTouch.Validate( "KGBA", "Declared Auto_Dimmer" );
|
|
|
Lamps(1) := new Switch.Toggle;
|
Lamps(1) := new Switch.Toggle;
|
Lamps(2) := new Switch.Dimmer;
|
Lamps(2) := new Switch.Dimmer;
|
Lamps(3) := new Switch.Auto_Dimmer;
|
Lamps(3) := new Switch.Auto_Dimmer;
|
|
|
-- Check use of static tagged allocated objects,
|
-- Check use of static tagged allocated objects,
|
-- and static tagged formal parameters in a loop which may dynamically
|
-- and static tagged formal parameters in a loop which may dynamically
|
-- dispatch. If an optimizer unrolls the loop, it may then be statically
|
-- dispatch. If an optimizer unrolls the loop, it may then be statically
|
-- determined, and no dispatching will occur. Either interpretation is
|
-- determined, and no dispatching will occur. Either interpretation is
|
-- correct.
|
-- correct.
|
for Knob in Lamps'Range loop
|
for Knob in Lamps'Range loop
|
Switch.Flip( Lamps(Knob).all );
|
Switch.Flip( Lamps(Knob).all );
|
end loop;
|
end loop;
|
TCTouch.Validate( "AGBAKGBA", "Allocated Objects" );
|
TCTouch.Validate( "AGBAKGBA", "Allocated Objects" );
|
|
|
-- Check use of static tagged declared objects,
|
-- Check use of static tagged declared objects,
|
-- calling non-primitive functions.
|
-- calling non-primitive functions.
|
if not Switch.TC_Non_Disp( A_Switch ) then
|
if not Switch.TC_Non_Disp( A_Switch ) then
|
Report.Failed( "Bad Value 1" );
|
Report.Failed( "Bad Value 1" );
|
end if;
|
end if;
|
TCTouch.Validate( "X", "Nonprimitive Function" );
|
TCTouch.Validate( "X", "Nonprimitive Function" );
|
|
|
if not Switch.TC_Non_Disp( A_Dimmer ) then
|
if not Switch.TC_Non_Disp( A_Dimmer ) then
|
Report.Failed( "Bad Value 2" );
|
Report.Failed( "Bad Value 2" );
|
end if;
|
end if;
|
TCTouch.Validate( "Y", "Nonprimitive Function" );
|
TCTouch.Validate( "Y", "Nonprimitive Function" );
|
|
|
if not Switch.TC_Non_Disp( An_Autodim ) then
|
if not Switch.TC_Non_Disp( An_Autodim ) then
|
Report.Failed( "Bad Value 3" );
|
Report.Failed( "Bad Value 3" );
|
end if;
|
end if;
|
TCTouch.Validate( "Z", "Nonprimitive Function" );
|
TCTouch.Validate( "Z", "Nonprimitive Function" );
|
|
|
A_Switch := Switch.Create;
|
A_Switch := Switch.Create;
|
A_Dimmer := Switch.Create;
|
A_Dimmer := Switch.Create;
|
An_Autodim := Switch.Create;
|
An_Autodim := Switch.Create;
|
TCTouch.Validate( "123", "Primitive Function" );
|
TCTouch.Validate( "123", "Primitive Function" );
|
|
|
-- View conversions
|
-- View conversions
|
Switch.Brighten( An_Autodim, 50 );
|
Switch.Brighten( An_Autodim, 50 );
|
|
|
Switch.Flip( Switch.Toggle( A_Switch ) );
|
Switch.Flip( Switch.Toggle( A_Switch ) );
|
Switch.Flip( Switch.Toggle( A_Dimmer ) );
|
Switch.Flip( Switch.Toggle( A_Dimmer ) );
|
Switch.Flip( Switch.Dimmer( An_Autodim ) );
|
Switch.Flip( Switch.Dimmer( An_Autodim ) );
|
TCTouch.Validate( "DAAGBA", "View Conversions" );
|
TCTouch.Validate( "DAAGBA", "View Conversions" );
|
|
|
-- statically tagged controlling operands (specific types) provided to
|
-- statically tagged controlling operands (specific types) provided to
|
-- class-wide functions
|
-- class-wide functions
|
if Switch.On( A_Switch )
|
if Switch.On( A_Switch )
|
or Switch.On( A_Dimmer )
|
or Switch.On( A_Dimmer )
|
or Switch.On( An_Autodim ) then
|
or Switch.On( An_Autodim ) then
|
Report.Failed( "Bad Value 4" );
|
Report.Failed( "Bad Value 4" );
|
end if;
|
end if;
|
TCTouch.Validate( "BBB", "Class-wide" );
|
TCTouch.Validate( "BBB", "Class-wide" );
|
|
|
-- statically tagged controlling operands qualified expressions provided to
|
-- statically tagged controlling operands qualified expressions provided to
|
-- primitive functions, also using context to determine call to a
|
-- primitive functions, also using context to determine call to a
|
-- class-wide function.
|
-- class-wide function.
|
if Switch.Off( Switch.Toggle'( Switch.Create ) )
|
if Switch.Off( Switch.Toggle'( Switch.Create ) )
|
or else Switch.Off( Switch.Dimmer'( Switch.Create ) )
|
or else Switch.Off( Switch.Dimmer'( Switch.Create ) )
|
or else Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then
|
or else Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then
|
Report.Failed( "Bad Value 5" );
|
Report.Failed( "Bad Value 5" );
|
end if;
|
end if;
|
TCTouch.Validate( "1C2C3C", "Qualified Expression/Class-Wide" );
|
TCTouch.Validate( "1C2C3C", "Qualified Expression/Class-Wide" );
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C392C05;
|
end C392C05;
|
|
|
