1-- C392C05.A 2-- 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, 6-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 7-- unlimited rights in the software and documentation contained herein. 8-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making 9-- this public release, the Government intends to confer upon all 10-- recipients unlimited rights equal to those held by the Government. 11-- These rights include rights to use, duplicate, release or disclose the 12-- released technical data and computer software in whole or in part, in 13-- any manner and for any purpose whatsoever, and to have or permit others 14-- to do so. 15-- 16-- DISCLAIMER 17-- 18-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 19-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 20-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 21-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 22-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 23-- PARTICULAR PURPOSE OF SAID MATERIAL. 24--* 25-- 26-- OBJECTIVE: 27-- Check that for a call to a dispatching subprogram the subprogram 28-- body which is executed is determined by the controlling tag for 29-- the case where the call has statically tagged controlling operands 30-- of the type T. Check this for various operands of tagged types: 31-- objects (declared or allocated), formal parameters, view conversions, 32-- function calls (both primitive and non-primitive). 33-- 34-- TEST DESCRIPTION: 35-- This test uses foundation F392C00 to test the usages of statically 36-- tagged objects and values. The calls to Validate indicate the 37-- expected sequence of procedure calls since the previous call to 38-- Validate. Static tags can be determined at compile time, and 39-- hence this is a test of correct overload resolution for tagged types. 40-- A clever compiler which unrolls loops and does path analysis on 41-- access values will be able to perform the same kind of determination 42-- for all of the code in this test. 43-- 44-- TEST FILES: 45-- The following files comprise this test: 46-- 47-- F392C00.A (foundation code) 48-- C392C05.A 49-- 50-- 51-- CHANGE HISTORY: 52-- 06 Dec 94 SAIC ACVC 2.0 53-- 19 Dec 94 SAIC Removed RM references from objective text. 54-- 24 Oct 95 SAIC Updated for ACVC 2.0.1 55-- 13 Feb 97 PWB.CTA Corrected assumption that "or" operands are 56-- evaluated in textual order. 57--! 58 59with Report; 60with TCTouch; 61with F392C00_1; 62procedure C392C05 is -- Hardware_Store 63 64 package Switch renames F392C00_1; 65 66 subtype Switch_Class is Switch.Toggle'Class; 67 68 type Reference is access all Switch_Class; 69 70 A_Switch : aliased Switch.Toggle; 71 A_Dimmer : aliased Switch.Dimmer; 72 An_Autodim : aliased Switch.Auto_Dimmer; 73 74 type Light_Bank is array(Positive range <>) of Reference; 75 76 Lamps : Light_Bank(1..3); 77 78begin -- Main test procedure. 79 80 Report.Test ("C392C05", "Check that a dispatching subprogram call is " 81 & "determined by the controlling tag for statically " 82 & "tagged controlling operands" ); 83 84-- Check use of static tagged declared objects, 85-- and static tagged formal parameters 86-- Must call correct version of flip based on type of controlling op. 87 88-- Turn on the lights! 89 90 Switch.Flip( A_Switch ); 91 TCTouch.Validate( "A", "Declared Toggle" ); 92 93 Switch.Flip( A_Dimmer ); 94 TCTouch.Validate( "GBA", "Declared Dimmer" ); 95 96 Switch.Flip( An_Autodim ); 97 TCTouch.Validate( "KGBA", "Declared Auto_Dimmer" ); 98 99 Lamps(1) := new Switch.Toggle; 100 Lamps(2) := new Switch.Dimmer; 101 Lamps(3) := new Switch.Auto_Dimmer; 102 103-- Check use of static tagged allocated objects, 104-- and static tagged formal parameters in a loop which may dynamically 105-- dispatch. If an optimizer unrolls the loop, it may then be statically 106-- determined, and no dispatching will occur. Either interpretation is 107-- correct. 108 for Knob in Lamps'Range loop 109 Switch.Flip( Lamps(Knob).all ); 110 end loop; 111 TCTouch.Validate( "AGBAKGBA", "Allocated Objects" ); 112 113-- Check use of static tagged declared objects, 114-- calling non-primitive functions. 115 if not Switch.TC_Non_Disp( A_Switch ) then 116 Report.Failed( "Bad Value 1" ); 117 end if; 118 TCTouch.Validate( "X", "Nonprimitive Function" ); 119 120 if not Switch.TC_Non_Disp( A_Dimmer ) then 121 Report.Failed( "Bad Value 2" ); 122 end if; 123 TCTouch.Validate( "Y", "Nonprimitive Function" ); 124 125 if not Switch.TC_Non_Disp( An_Autodim ) then 126 Report.Failed( "Bad Value 3" ); 127 end if; 128 TCTouch.Validate( "Z", "Nonprimitive Function" ); 129 130 A_Switch := Switch.Create; 131 A_Dimmer := Switch.Create; 132 An_Autodim := Switch.Create; 133 TCTouch.Validate( "123", "Primitive Function" ); 134 135-- View conversions 136 Switch.Brighten( An_Autodim, 50 ); 137 138 Switch.Flip( Switch.Toggle( A_Switch ) ); 139 Switch.Flip( Switch.Toggle( A_Dimmer ) ); 140 Switch.Flip( Switch.Dimmer( An_Autodim ) ); 141 TCTouch.Validate( "DAAGBA", "View Conversions" ); 142 143-- statically tagged controlling operands (specific types) provided to 144-- class-wide functions 145 if Switch.On( A_Switch ) 146 or Switch.On( A_Dimmer ) 147 or Switch.On( An_Autodim ) then 148 Report.Failed( "Bad Value 4" ); 149 end if; 150 TCTouch.Validate( "BBB", "Class-wide" ); 151 152-- statically tagged controlling operands qualified expressions provided to 153-- primitive functions, also using context to determine call to a 154-- class-wide function. 155 if Switch.Off( Switch.Toggle'( Switch.Create ) ) 156 or else Switch.Off( Switch.Dimmer'( Switch.Create ) ) 157 or else Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then 158 Report.Failed( "Bad Value 5" ); 159 end if; 160 TCTouch.Validate( "1C2C3C", "Qualified Expression/Class-Wide" ); 161 162 Report.Result; 163 164end C392C05; 165