aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/c3/c393a02.a
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c3/c393a02.a')
-rw-r--r--gcc/testsuite/ada/acats/tests/c3/c393a02.a213
1 files changed, 0 insertions, 213 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c393a02.a b/gcc/testsuite/ada/acats/tests/c3/c393a02.a
deleted file mode 100644
index 177bd34b87e..00000000000
--- a/gcc/testsuite/ada/acats/tests/c3/c393a02.a
+++ /dev/null
@@ -1,213 +0,0 @@
--- C393A02.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 a dispatching call to an abstract subprogram invokes
--- the correct subprogram body of a descendant type according to
--- the controlling tag.
--- Check that a subprogram can be declared with formal parameters
--- and result that are of an abstract type's associated class-wide
--- type and that such subprograms can be called. 3.4.1(4)
---
--- TEST DESCRIPTION:
--- This test declares several objects of types derived from the
--- abstract type as defined in the foundation F393A00. It then calls
--- various dispatching and class-wide subprograms using those objects.
--- The packages in F393A00 are instrumented to trace the flow of
--- execution.
--- The test checks for the correct order of execution, as expected
--- by the various calls.
---
--- TEST FILES:
--- The following files comprise this test:
---
--- F393A00.A (foundation code)
--- C393A02.A
---
---
--- CHANGE HISTORY:
--- 06 Dec 94 SAIC ACVC 2.0
--- 19 Dec 94 SAIC Removed RM references from objective text.
--- 05 APR 96 SAIC Update RM references for 2.1
---
---!
-
-with Report;
-with F393A00_0;
-with F393A00_1;
-with F393A00_2;
-with F393A00_3;
-with F393A00_4;
-procedure C393A02 is
-
- A_Windmill : F393A00_2.Windmill;
- A_Pump : F393A00_3.Pump;
- A_Mill : F393A00_4.Mill;
-
- A_Windmill_2 : F393A00_2.Windmill;
- A_Pump_2 : F393A00_3.Pump;
- A_Mill_2 : F393A00_4.Mill;
-
- B_Windmill : F393A00_2.Windmill;
- B_Pump : F393A00_3.Pump;
- B_Mill : F393A00_4.Mill;
-
- procedure Swapem( A,B: in out F393A00_2.Windmill'Class ) is
- begin
- F393A00_0.TC_Touch('x');
- F393A00_2.Swap( A,B );
- end Swapem;
-
- function Zephyr( A: F393A00_2.Windmill'Class )
- return F393A00_2.Windmill'Class is
- Item : F393A00_2.Windmill'Class := A;
- begin
- F393A00_0.TC_Touch('y');
- if not F393A00_1.Initialized( Item ) then -- b
- F393A00_2.Initialize( Item ); -- a
- end if;
- F393A00_2.Stop( Item ); -- f / mff
- F393A00_2.Add_Spin( Item, 10 ); -- e
- return Item;
- end Zephyr;
-
- function Gale( It: F393A00_2.Windmill ) return F393A00_2.Windmill'Class is
- Item : F393A00_2.Windmill'Class := It;
- begin
- F393A00_2.Stop( Item ); -- f
- F393A00_2.Add_Spin( Item, 40 ); -- e
- return Item;
- end Gale;
-
- function Gale( It: F393A00_3.Pump ) return F393A00_2.Windmill'Class is
- Item : F393A00_2.Windmill'Class := It;
- begin
- F393A00_2.Stop( Item ); -- f
- F393A00_2.Add_Spin( Item, 50 ); -- e
- return Item;
- end Gale;
-
- function Gale( It: F393A00_4.Mill ) return F393A00_2.Windmill'Class is
- Item : F393A00_2.Windmill'Class := It;
- begin
- F393A00_2.Stop( Item ); -- mff
- F393A00_2.Add_Spin( Item, 60 ); -- e
- return Item;
- end Gale;
-
-begin -- Main test procedure.
-
- Report.Test ("C393A02", "Check that a dispatching call to an abstract "
- & "subprogram invokes the correct subprogram body. "
- & "Check that a subprogram declared with formal "
- & "parameters/result of an abstract type's "
- & "associated class-wide can be called" );
-
- F393A00_0.TC_Validate( "hhh", "Mill declarations" );
- A_Windmill := F393A00_2.Create;
- F393A00_0.TC_Validate( "d", "Create A_Windmill" );
-
- A_Pump := F393A00_3.Create;
- F393A00_0.TC_Validate( "h", "Create A_Pump" );
-
- A_Mill := F393A00_4.Create;
- F393A00_0.TC_Validate( "hl", "Create A_Mill" );
-
- --------------
-
- Swapem( A_Windmill, A_Windmill_2 );
- F393A00_0.TC_Validate( "xc", "Windmill Swap" );
-
- Swapem( A_Pump, A_Pump_2 );
- F393A00_0.TC_Validate( "xc", "Pump Swap" );
-
- Swapem( A_Mill, A_Mill_2 );
- F393A00_0.TC_Validate( "xk", "Pump Swap" );
-
- F393A00_2.Initialize( A_Windmill_2 );
- F393A00_3.Initialize( A_Pump_2 );
- F393A00_4.Initialize( A_Mill_2 );
- B_Windmill := A_Windmill_2;
- B_Pump := A_Pump_2;
- B_Mill := A_Mill_2;
- F393A00_2.Add_Spin( B_Windmill, 123 );
- F393A00_3.Set_Rate( B_Pump, 12.34 );
- F393A00_4.Add_Spin( B_Mill, 321 );
- F393A00_0.TC_Validate( "aaaeie", "Setting Values" );
-
- declare
- It : F393A00_2.Windmill'Class := Zephyr( B_Windmill ); -- ybfe
- XX : F393A00_2.Windmill'Class := Gale( B_Windmill ); -- fe
- use type F393A00_2.Rotational_Measurement;
- begin
- if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
-then
- Report.Failed( "Copy to class-wide variable" );
- end if; -- bb
- if F393A00_2.Spin( It ) /= 10 -- g
- or F393A00_2.Spin( XX ) /= 40 then -- g
- Report.Failed( "Call to class-wide operation" );
- end if;
-
- F393A00_0.TC_Validate( "ybfefebbgg", "Windmill Zephyr" );
- end;
-
- declare
- It : F393A00_2.Windmill'Class := Zephyr( B_Pump ); -- ybfe
- XX : F393A00_2.Windmill'Class := Gale( B_Pump ); -- fe
- use type F393A00_2.Rotational_Measurement;
- begin
- if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
-then
- Report.Failed( "Bad copy to class-wide variable" );
- end if; -- bb
- if F393A00_2.Spin( It ) /= 10 -- g
- or F393A00_2.Spin( XX ) /= 50 then -- g
- Report.Failed( "Call to class-wide operation" );
- end if;
-
- F393A00_0.TC_Validate( "ybfefebbgg", "Pump Zephyr" );
- end;
-
- declare
- It : F393A00_2.Windmill'Class := Zephyr( B_Mill ); -- ybmffe
- XX : F393A00_2.Windmill'Class := Gale( B_Mill ); -- mffe
- use type F393A00_2.Rotational_Measurement;
- begin
- if not F393A00_1.Initialized( It ) or not F393A00_1.Initialized( XX )
-then
- Report.Failed( "Bad copy to class-wide variable" );
- end if; -- bb
- if F393A00_2.Spin( It ) /= 10 -- g
- or F393A00_2.Spin( XX ) /= 60 then -- g
- Report.Failed( "Call to class-wide operation" );
- end if;
-
- F393A00_0.TC_Validate( "ybmffemffebbgg", "Mill Zephyr" );
- end;
-
- Report.Result;
-
-end C393A02;
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-27 22:22:56 +0000