diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/c3/c393a05.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/c3/c393a05.a | 166 |
1 files changed, 0 insertions, 166 deletions
diff --git a/gcc/testsuite/ada/acats/tests/c3/c393a05.a b/gcc/testsuite/ada/acats/tests/c3/c393a05.a deleted file mode 100644 index b404559cc83..00000000000 --- a/gcc/testsuite/ada/acats/tests/c3/c393a05.a +++ /dev/null @@ -1,166 +0,0 @@ --- C393A05.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 nonabstract private extension, any inherited - -- abstract subprograms can be overridden in the private part of - -- the immediately enclosing package and that calls can be made to - -- private dispatching operations. - -- - -- TEST DESCRIPTION: - -- This test builds an additional layer upon the foundation code to - -- provide the required "hidden" dispatching operation. The procedure - -- Swap, a private subprogram, should be called by dispatch. - -- - -- TEST FILES: - -- The following files comprise this test: - -- - -- F393A00.A (foundation code) - -- C393A05.A - -- - -- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- - --! - - with F393A00_4; - package C393A05_0 is - type Grinder is new F393A00_4.Mill with private; - type Coarseness is (Whole_Bean, Coarse, Medium, Fine, Espresso); - - procedure Set_Grind( It: in out Grinder; The_Grind: Coarseness ); - function Grind( It: Grinder ) return Coarseness; - - function Create return Grinder; - private - procedure Swap( A,B: in out Grinder ); - type Grinder is new F393A00_4.Mill with - record - Grind : Coarseness := Whole_Bean; - end record; - end C393A05_0; - - with F393A00_0; - package body C393A05_0 is - procedure Set_Grind( It: in out Grinder; The_Grind: Coarseness ) is - begin - F393A00_0.TC_Touch( 'A' ); - It.Grind := The_Grind; - end Set_Grind; - - function Grind( It: Grinder ) return Coarseness is - begin - F393A00_0.TC_Touch( 'B' ); - return It.Grind; - end Grind; - - procedure Swap( A,B: in out Grinder ) is - T : constant Grinder := A; - begin - F393A00_0.TC_Touch( 'C' ); - A := B; - B := T; - end Swap; - - function Create return Grinder is - One: Grinder; - begin - F393A00_0.TC_Touch( 'D' ); - F393A00_4.Initialize( F393A00_4.Mill( One ) ); - One.Grind := Fine; - return One; - end Create; - end C393A05_0; - - with Report; - with F393A00_0; - with C393A05_0; - procedure C393A05 is - - package Tracer renames F393A00_0; - package Coffee renames C393A05_0; - use type Coffee.Coarseness; - - Morning : Coffee.Grinder; - Afternoon : Coffee.Grinder; - - Gritty : Coffee.Coarseness; - - procedure Class_Swap( A, B: in out Coffee.Grinder'Class ) is - begin - Coffee.Swap( A, B ); -- dispatch - end Class_Swap; - - begin -- Main test procedure. - - Report.Test ("C393A05", "Check that nonabstract private extensions, " - & "inherited abstract subprograms overridden " - & "in the private part can be dispatched from " - & "outside the package" ); - - Tracer.TC_Validate( "hh", "Declarations" ); - - Morning := Coffee.Create; - Tracer.TC_Validate( "hDa", "Creating Morning Coffee" ); - Gritty := Coffee.Grind( Morning ); - Tracer.TC_Validate( "B", "Finding Morning Grind" ); - - Afternoon := Coffee.Create; - Tracer.TC_Validate( "hDa", "Creating Afternoon Coffee" ); - Coffee.Set_Grind( Afternoon, Coffee.Medium ); - Tracer.TC_Validate( "A", "Setting Afternoon Grind" ); - - Coffee.Swap( Morning, Afternoon ); - Tracer.TC_Validate( "C", "Dispatching Swapping Coffees" ); - - if Gritty /= Coffee.Grind( Afternoon ) - or Coffee.Grind ( Afternoon ) /= Coffee.Fine then - Report.Failed ("Result of Swap"); - end if; - Tracer.TC_Validate( "BB", "Finding Afternoon Grind" ); - - Sunset: declare - Evening : Coffee.Grinder'Class := Coffee.Create; - begin - Tracer.TC_Validate( "hDa", "Creating Evening Coffee" ); - - Coffee.Set_Grind( Evening, Coffee.Espresso ); - Tracer.TC_Validate( "A", "Setting Evening Grind" ); - - Morning := Coffee.Grinder( Evening ); - Class_Swap( Morning, Evening ); - Tracer.TC_Validate( "C", "Swapping Coffees" ); - if Coffee.Grind( Morning ) /= Coffee.Espresso then - Report.Failed ("Result of Assignment"); - end if; - end Sunset; - - Report.Result; - - end C393A05; - - - |