Subversion Repositories openrisc_me

-- C392C05.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 for a call to a dispatching subprogram the subprogram

--     body which is executed is determined by the controlling tag for

--     the case where the call has statically tagged controlling operands

--     of the type T.  Check this for various operands of tagged types:

--     objects (declared or allocated), formal parameters, view conversions,

--     function calls (both primitive and non-primitive).

--

-- TEST DESCRIPTION:

--      This test uses foundation F392C00 to test the usages of statically

--      tagged objects and values.  The calls to Validate indicate the

--      expected sequence of procedure calls since the previous call to

--      Validate.  Static tags can be determined at compile time, and

--      hence this is a test of correct overload resolution for tagged types.

--      A clever compiler which unrolls loops and does path analysis on

--      access values will be able to perform the same kind of determination

--      for all of the code in this test.

--

-- TEST FILES:

--      The following files comprise this test:

--

--         F392C00.A   (foundation code)

--         C392C05.A

--

--

-- CHANGE HISTORY:

--      06 Dec 94   SAIC    ACVC 2.0

--      19 Dec 94   SAIC    Removed RM references from objective text.

--      24 Oct 95   SAIC    Updated for ACVC 2.0.1

--      13 Feb 97   PWB.CTA Corrected assumption that "or" operands are

--                          evaluated in textual order.

--!

with Report;

with TCTouch;

with F392C00_1;

procedure C392C05 is -- Hardware_Store

  package Switch renames F392C00_1;

  subtype Switch_Class is Switch.Toggle'Class;

  type Reference is access all Switch_Class;

  A_Switch   : aliased Switch.Toggle;

  A_Dimmer   : aliased Switch.Dimmer;

  An_Autodim : aliased Switch.Auto_Dimmer;

  type Light_Bank is array(Positive range <>) of Reference;

  Lamps : Light_Bank(1..3);

begin  -- Main test procedure.

  Report.Test ("C392C05", "Check that a dispatching subprogram call is "

                        & "determined by the controlling tag for statically "

                        & "tagged controlling operands" );

-- Check use of static tagged declared objects,

--   and static tagged formal parameters

-- Must call correct version of flip based on type of controlling op.

-- Turn on the lights!

  Switch.Flip( A_Switch );

  TCTouch.Validate( "A", "Declared Toggle" );

  Switch.Flip( A_Dimmer );

  TCTouch.Validate( "GBA", "Declared Dimmer" );

  Switch.Flip( An_Autodim );

  TCTouch.Validate( "KGBA", "Declared Auto_Dimmer" );

  Lamps(1) := new Switch.Toggle;

  Lamps(2) := new Switch.Dimmer;

  Lamps(3) := new Switch.Auto_Dimmer;

-- Check use of static tagged allocated objects,

--   and static tagged formal parameters in a loop which may dynamically

--   dispatch.  If an optimizer unrolls the loop, it may then be statically

--   determined, and no dispatching will occur.  Either interpretation is

--   correct.

  for Knob in Lamps'Range loop

    Switch.Flip( Lamps(Knob).all );

  end loop;

  TCTouch.Validate( "AGBAKGBA", "Allocated Objects" );

-- Check use of static tagged declared objects,

--   calling non-primitive functions.

  if not Switch.TC_Non_Disp( A_Switch ) then

    Report.Failed( "Bad Value 1" );

  end if;

  TCTouch.Validate( "X", "Nonprimitive Function" );

  if not Switch.TC_Non_Disp( A_Dimmer ) then

    Report.Failed( "Bad Value 2" );

  end if;

  TCTouch.Validate( "Y", "Nonprimitive Function" );

  if not Switch.TC_Non_Disp( An_Autodim ) then

    Report.Failed( "Bad Value 3" );

  end if;

  TCTouch.Validate( "Z", "Nonprimitive Function" );

  A_Switch   := Switch.Create;

  A_Dimmer   := Switch.Create;

  An_Autodim := Switch.Create;

  TCTouch.Validate( "123", "Primitive Function" );

-- View conversions

  Switch.Brighten( An_Autodim, 50 );

  Switch.Flip( Switch.Toggle( A_Switch ) );

  Switch.Flip( Switch.Toggle( A_Dimmer ) );

  Switch.Flip( Switch.Dimmer( An_Autodim ) );

  TCTouch.Validate( "DAAGBA", "View Conversions" );

-- statically tagged controlling operands (specific types) provided to

-- class-wide functions

  if Switch.On( A_Switch )

     or Switch.On( A_Dimmer )

     or Switch.On( An_Autodim ) then

    Report.Failed( "Bad Value 4" );

  end if;

  TCTouch.Validate( "BBB", "Class-wide" );

-- statically tagged controlling operands qualified expressions provided to

-- primitive functions, also using context to determine call to a

-- class-wide function.

  if Switch.Off( Switch.Toggle'( Switch.Create ) )

     or else Switch.Off( Switch.Dimmer'( Switch.Create ) )

     or else Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then

    Report.Failed( "Bad Value 5" );

  end if;

  TCTouch.Validate( "1C2C3C", "Qualified Expression/Class-Wide" );

  Report.Result;

end C392C05;