diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cc/cc51a01.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cc/cc51a01.a | 193 |
1 files changed, 0 insertions, 193 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cc/cc51a01.a b/gcc/testsuite/ada/acats/tests/cc/cc51a01.a deleted file mode 100644 index 60c32be47f2..00000000000 --- a/gcc/testsuite/ada/acats/tests/cc/cc51a01.a +++ /dev/null @@ -1,193 +0,0 @@ --- CC51A01.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, in an instance, each implicit declaration of a user-defined --- subprogram of a formal derived record type declares a view of the --- corresponding primitive subprogram of the ancestor, even if the --- primitive subprogram has been overridden for the actual type. --- --- TEST DESCRIPTION: --- Declare a "fraction" type abstraction in a package (foundation code). --- Declare a "fraction" I/O routine in a generic package with a formal --- derived type whose ancestor type is the fraction type declared in --- the first package. Within the I/O routine, call other operations of --- ancestor type. Derive from the root fraction type in another package --- and override one of the operations called in the generic I/O routine. --- Derive from the derivative of the root fraction type. Instantiate --- the generic package for each of the three types and call the I/O --- routine. --- --- TEST FILES: --- The following files comprise this test: --- --- FC51A00.A --- CC51A01.A --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -with FC51A00; -- Fraction type abstraction. -generic -- Fraction I/O support. - type Fraction is new FC51A00.Fraction_Type; -- Formal derived type of a -package CC51A01_0 is -- (private) record type. - - -- Simulate writing a fraction to standard output. In a real application, - -- this subprogram might be a procedure which uses Text_IO routines. For - -- the purposes of the test, the "output" is returned to the caller as a - -- string. - function Put (Item : in Fraction) return String; - - -- ... Other I/O operations for fractions. - -end CC51A01_0; - - - --==================================================================-- - - -package body CC51A01_0 is - - function Put (Item : in Fraction) return String is - Num : constant String := -- Fraction's primitive subprograms - Integer'Image (Numerator (Item)); -- are inherited from its parent - Den : constant String := -- (FC51A00.Fraction_Type) and NOT - Integer'Image (Denominator (Item)); -- from the actual type. - begin - return (Num & '/' & Den); - end Put; - -end CC51A01_0; - - - --==================================================================-- - - -with FC51A00; -- Fraction type abstraction. -package CC51A01_1 is - - -- Derive directly from the root type of the class and override one of the - -- primitive subprograms. - - type Pos_Fraction is new FC51A00.Fraction_Type; -- Derived directly from - -- root type of class. - -- Inherits "/" from root type. - -- Inherits "-" from root type. - -- Inherits Numerator from root type. - -- Inherits Denominator from root type. - - -- Return absolute value of numerator as integer. - function Numerator (Frac : Pos_Fraction) -- Overrides parent's - return Integer; -- operation. - -end CC51A01_1; - - - --==================================================================-- - - -package body CC51A01_1 is - - -- This body should never be called. - -- - -- The test sends the function Numerator a fraction with a negative - -- numerator, and expects this negative numerator to be returned. This - -- version of the function returns the absolute value of the numerator. - -- Thus, a call to this version is detectable by examining the sign - -- of the return value. - - function Numerator (Frac : Pos_Fraction) return Integer is - Converted_Frac : FC51A00.Fraction_Type := FC51A00.Fraction_Type (Frac); - Orig_Numerator : Integer := FC51A00.Numerator (Converted_Frac); - begin - return abs (Orig_Numerator); - end Numerator; - -end CC51A01_1; - - - --==================================================================-- - - -with FC51A00; -- Fraction type abstraction. -with CC51A01_0; -- Fraction I/O support. -with CC51A01_1; -- Positive fraction type abstraction. - -with Report; -procedure CC51A01 is - - type Distance is new CC51A01_1.Pos_Fraction; -- Derived indirectly from - -- root type of class. - -- Inherits "/" indirectly from root type. - -- Inherits "-" indirectly from root type. - -- Inherits Numerator directly from parent type. - -- Inherits Denominator indirectly from root type. - - use FC51A00, CC51A01_1; -- All primitive subprograms - -- directly visible. - - package Fraction_IO is new CC51A01_0 (Fraction_Type); - package Pos_Fraction_IO is new CC51A01_0 (Pos_Fraction); - package Distance_IO is new CC51A01_0 (Distance); - - -- For each of the instances above, the subprogram "Put" should produce - -- the same result. That is, the primitive subprograms called by Put - -- should in all cases be those of the type Fraction_Type, which is the - -- ancestor type for the formal derived type in the generic unit. In - -- particular, for Pos_Fraction_IO and Distance_IO, the versions of - -- Numerator called should NOT be those of the actual types, which override - -- Fraction_Type's version. - - TC_Expected_Result : constant String := "-3/ 16"; - - TC_Root_Type_Of_Class : Fraction_Type := -3/16; - TC_Direct_Derivative : Pos_Fraction := -3/16; - TC_Indirect_Derivative : Distance := -3/16; - -begin - Report.Test ("CC51A01", "Check that, in an instance, each implicit " & - "declaration of a user-defined subprogram of a formal " & - "derived record type declares a view of the corresponding " & - "primitive subprogram of the ancestor, even if the " & - "primitive subprogram has been overridden for the actual " & - "type"); - - if (Fraction_IO.Put (TC_Root_Type_Of_Class) /= TC_Expected_Result) then - Report.Failed ("Wrong result for root type"); - end if; - - if (Pos_Fraction_IO.Put (TC_Direct_Derivative) /= TC_Expected_Result) then - Report.Failed ("Wrong result for direct derivative"); - end if; - - if (Distance_IO.Put (TC_Indirect_Derivative) /= TC_Expected_Result) then - Report.Failed ("Wrong result for INdirect derivative"); - end if; - - Report.Result; -end CC51A01; |