diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cc/cc51006.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cc/cc51006.a | 224 |
1 files changed, 0 insertions, 224 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cc/cc51006.a b/gcc/testsuite/ada/acats/tests/cc/cc51006.a deleted file mode 100644 index b4dc4cdb4d4..00000000000 --- a/gcc/testsuite/ada/acats/tests/cc/cc51006.a +++ /dev/null @@ -1,224 +0,0 @@ --- CC51006.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 primitive --- subprogram of a formal (nontagged) derived type declares a view of --- the corresponding primitive subprogram of the ancestor type, even if --- the subprogram has been overridden for the actual type. Check that for --- a formal derived type with no discriminant part, if the ancestor --- subtype is an unconstrained scalar subtype then the actual may be --- either constrained or unconstrained. --- --- TEST DESCRIPTION: --- The formal derived type has no discriminant part, but the ancestor --- subtype is unconstrained, making the formal type unconstrained. Since --- the ancestor subtype is a scalar subtype (not an access or composite --- subtype), the actual may be either constrained or unconstrained. --- --- Declare a root type of a class as an unconstrained scalar (use floating --- point). Declare a primitive subprogram of the root type. Declare a --- generic package which has a formal derived type with the scalar root --- type as ancestor. Inside the generic, declare an operation which calls --- the ancestor type's primitive subprogram. Derive both constrained and --- unconstrained types from the root type and override the primitive --- subprogram for each. Declare a constrained subtype of the unconstrained --- derivative. Instantiate the generic package for the derived types and --- the subtype and call the "generic" operation for each one. Confirm that --- in all cases the root type's implementation of the primitive --- subprogram is called. --- --- --- CHANGE HISTORY: --- 06 Dec 94 SAIC ACVC 2.0 --- ---! - -package CC51006_0 is -- Weight class. - - type Weight_Type is digits 3; -- Root type of class (unconstrained). - - function Weight_To_String (Wt : Weight_Type) return String; - - -- ... Other operations. - -end CC51006_0; - - - --==================================================================-- - - -package body CC51006_0 is - - -- The implementations of the operations below are purely artificial; the - -- validity of their implementations in the context of the abstraction is - -- irrelevant to the feature being tested. - - function Weight_To_String (Wt : Weight_Type) return String is - begin - if Wt > 0.0 then -- Always true for this test. - return ("Root type's implementation called"); - else - return ("Unexpected result "); - end if; - end Weight_To_String; - -end CC51006_0; - - - --==================================================================-- - - -with CC51006_0; -- Weight class. -generic -- Generic weight operations. - type Weight is new CC51006_0.Weight_Type; -package CC51006_1 is - - procedure Output_Weight (Wt : in Weight; TC_Return : out String); - - -- ... Other operations. - -end CC51006_1; - - - --==================================================================-- - - -package body CC51006_1 is - - - -- The implementation of this procedure is purely artificial, and contains - -- an artificial parameter for testing purposes: the procedure returns the - -- weight string to the caller. - - procedure Output_Weight (Wt : in Weight; TC_Return : out String) is - begin - TC_Return := Weight_To_String (Wt); -- Should always call root type's - end Output_Weight; -- implementation. - - -end CC51006_1; - - - --==================================================================-- - - -with CC51006_0; -- Weight class. -use CC51006_0; -package CC51006_2 is -- Extensions to weight class. - - type Grams is new Weight_Type; -- Unconstrained - -- derivative. - - function Weight_To_String (Wt : Grams) return String; -- Overrides root - -- type's operation. - - subtype Milligrams is Grams -- Constrained - range 0.0 .. 0.999; -- subtype (of der.). - - type Pounds is new Weight_Type -- Constrained - range 0.0 .. 500.0; -- derivative. - - function Weight_To_String (Wt : Pounds) return String; -- Overrides root - -- type's operation. - -end CC51006_2; - - - --==================================================================-- - - -package body CC51006_2 is - - -- The implementations of the operations below are purely artificial; the - -- validity of their implementations in the context of the abstraction is - -- irrelevant to the feature being tested. - - function Weight_To_String (Wt : Grams) return String is - begin - return ("GRAMS: Should never be called "); - end Weight_To_String; - - - function Weight_To_String (Wt : Pounds) return String is - begin - return ("POUNDS: Should never be called "); - end Weight_To_String; - -end CC51006_2; - - - --==================================================================-- - - -with CC51006_1; -- Generic weight operations. -with CC51006_2; -- Extensions to weight class. - -with Report; -procedure CC51006 is - - package Metric_Wts_G is new CC51006_1 (CC51006_2.Grams); -- Unconstr. - package Metric_Wts_MG is new CC51006_1 (CC51006_2.Milligrams); -- Constr. - package US_Wts is new CC51006_1 (CC51006_2.Pounds); -- Constr. - - Gms : CC51006_2.Grams := 113.451; - Mgm : CC51006_2.Milligrams := 0.549; - Lbs : CC51006_2.Pounds := 24.52; - - - subtype TC_Buffers is String (1 .. 33); - - TC_Expected : constant TC_Buffers := "Root type's implementation called"; - TC_Buffer : TC_Buffers; - -begin - Report.Test ("CC51006", "Check that, in an instance, each implicit " & - "declaration of a primitive subprogram of a formal " & - "(nontagged) type declares a view of the corresponding " & - "primitive subprogram of the ancestor type"); - - - Metric_Wts_G.Output_Weight (Gms, TC_Buffer); - - if TC_Buffer /= TC_Expected then - Report.Failed ("Root operation not called for unconstrained derivative"); - end if; - - - Metric_Wts_MG.Output_Weight (Mgm, TC_Buffer); - - if TC_Buffer /= TC_Expected then - Report.Failed ("Root operation not called for constrained subtype"); - end if; - - - US_Wts.Output_Weight (Lbs, TC_Buffer); - - if TC_Buffer /= TC_Expected then - Report.Failed ("Root operation not called for constrained derivative"); - end if; - - Report.Result; -end CC51006; |