aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/c3/c392c07.a
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c3/c392c07.a')
-rw-r--r--gcc/testsuite/ada/acats/tests/c3/c392c07.a190
1 files changed, 0 insertions, 190 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c392c07.a b/gcc/testsuite/ada/acats/tests/c3/c392c07.a
deleted file mode 100644
index f13cc0b01a0..00000000000
--- a/gcc/testsuite/ada/acats/tests/c3/c392c07.a
+++ /dev/null
@@ -1,190 +0,0 @@
--- C392C07.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 dynamic tagged controlling operands
--- of the type T. Check for calls to these same subprograms where
--- the operands are of specific statically tagged types:
--- objects (declared or allocated), formal parameters, view
--- conversions, and function calls (both primitive and non-primitive).
---
--- TEST DESCRIPTION:
--- This test uses foundation F392C00 to test the usages of statically
--- tagged objects and values. This test is derived in part from
--- C392C05.
---
---
--- CHANGE HISTORY:
--- 06 Dec 94 SAIC ACVC 2.0
--- 24 Oct 95 SAIC Updated for ACVC 2.0.1
---
---!
-
-with Report;
-with TCTouch;
-with F392C00_1;
-procedure C392C07 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);
-
--- dynamically tagged controlling operands : class wide formal parameters
- procedure Clamp( Device : in out Switch_Class; On : Boolean := False ) is
- begin
- if Switch.On( Device ) /= On then
- Switch.Flip( Device );
- end if;
- end Clamp;
- function Class_Item(Bank_Pos: Positive) return Switch_Class is
- begin
- return Lamps(Bank_Pos).all;
- end Class_Item;
-
-begin -- Main test procedure.
- Report.Test ("C392C07", "Check that a dispatching subprogram call is "
- & "determined by the controlling tag for "
- & "dynamically tagged controlling operands" );
-
- Lamps := ( A_Switch'Access, A_Dimmer'Access, An_Autodim'Access );
-
--- dynamically tagged operands referring to
--- statically tagged declared objects
- for Knob in Lamps'Range loop
- Clamp( Lamps(Knob).all, On => True );
- end loop;
- TCTouch.Validate( "BABGBABKGBA", "Clamping On Lamps" );
-
- Lamps(1) := new Switch.Toggle;
- Lamps(2) := new Switch.Dimmer;
- Lamps(3) := new Switch.Auto_Dimmer;
-
--- turn the full bank of switches ON
--- dynamically tagged allocated objects
- for Knob in Lamps'Range loop
- Clamp( Lamps(Knob).all, On => True );
- end loop;
- TCTouch.Validate( "BABGBABKGBA", "Dynamic Allocated");
-
--- Double check execution correctness
- if Switch.Off( Lamps(1).all )
- or Switch.Off( Lamps(2).all )
- or Switch.Off( Lamps(3).all ) then
- Report.Failed( "Bad Value" );
- end if;
- TCTouch.Validate( "CCC", "Class-wide");
-
--- turn the full bank of switches OFF
- for Knob in Lamps'Range loop
- Switch.Flip( Lamps(Knob).all );
- end loop;
- TCTouch.Validate( "AGBAKGBA", "Dynamic Allocated, Primitive Ops");
-
--- check switches for OFF
--- a few function calls as operands
- for Knob in Lamps'Range loop
- if not Switch.Off( Class_Item(Knob) ) then
- Report.Failed("At function tests, Switch not OFF");
- end if;
- end loop;
- TCTouch.Validate( "CCC",
- "Using function returning class-wide type");
-
--- Switches are all OFF now.
--- dynamically tagged view conversion
- Clamp( Switch_Class( A_Switch ) );
- Clamp( Switch_Class( A_Dimmer ) );
- Clamp( Switch_Class( An_Autodim ) );
- TCTouch.Validate( "BABGBABKGBA", "View Conversions" );
-
--- dynamically tagged controlling operands : declared class wide objects
--- calling primitive functions
- declare
- Dine_O_Might : Switch_Class := Switch.TC_CW_TI( 't' );
- begin
- Switch.Flip( Dine_O_Might );
- if Switch.On( Dine_O_Might ) then
- Report.Failed( "Exploded at Dine_O_Might" );
- end if;
- TCTouch.Validate( "WAB", "Dispatching function 1" );
- end;
-
- declare
- Dyne_A_Mite : Switch_Class := Switch.TC_CW_TI( 'd' );
- begin
- Switch.Flip( Dyne_A_Mite );
- if Switch.On( Dyne_A_Mite ) then
- Report.Failed( "Exploded at Dyne_A_Mite" );
- end if;
- TCTouch.Validate( "WGBAB", "Dispatching function 2" );
- end;
-
- declare
- Din_Um_Out : Switch_Class := Switch.TC_CW_TI( 'a' );
- begin
- Switch.Flip( Din_Um_Out );
- if Switch.Off( Din_Um_Out ) then
- Report.Failed( "Exploded at Din_Um_Out" );
- end if;
- TCTouch.Validate( "WKCC", "Dispatching function 3" );
-
--- Non-dispatching function calls.
- if not Switch.TC_Non_Disp( Switch.Toggle( Din_Um_Out ) ) then
- Report.Failed( "Non primitive, via view conversion" );
- end if;
- TCTouch.Validate( "X", "View Conversion 1" );
-
- if not Switch.TC_Non_Disp( Switch.Dimmer( Din_Um_Out ) ) then
- Report.Failed( "Non primitive, via view conversion" );
- end if;
- TCTouch.Validate( "Y", "View Conversion 2" );
- end;
-
- -- a few more function calls as operands (oops)
- if not Switch.On( Switch.Toggle'( Switch.Create ) ) then
- Report.Failed("Toggle did not create ""On""");
- end if;
-
- if Switch.Off( Switch.Dimmer'( Switch.Create ) ) then
- Report.Failed("Dimmer created ""Off""");
- end if;
-
- if Switch.Off( Switch.Auto_Dimmer'( Switch.Create ) ) then
- Report.Failed("Auto_Dimmer created ""Off""");
- end if;
-
- Report.Result;
-end C392C07;
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-26 21:08:47 +0000