diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70002.a')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70002.a | 241 |
1 files changed, 241 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70002.a b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70002.a new file mode 100644 index 000000000..3e4d9c40b --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70002.a @@ -0,0 +1,241 @@ +-- CC70002.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 formal package actual part may specify actual parameters +-- for a generic formal package. Check that these actual parameters may +-- be formal types, formal objects, and formal subprograms. Check that +-- the visible part of the generic formal package includes the first list +-- of basic declarative items of the package specification, and that if +-- the formal package actual part is (<>), it also includes the generic +-- formal part of the template for the formal package. +-- +-- TEST DESCRIPTION: +-- Declare a generic package which defines a "signature" for mathematical +-- groups. Declare a second generic package which defines a +-- two-dimensional matrix abstraction. Declare a third generic package +-- which provides mathematical group operations for two-dimensional +-- matrices. Provide this third generic with two formal parameters: (1) +-- a generic formal package with the second generic as template and a +-- (<>) actual part, and (2) a generic formal package with the first +-- generic as template and an actual part that takes a formal type, +-- object, and subprogram from the first formal package as actuals. +-- +-- +-- CHANGE HISTORY: +-- 06 Dec 94 SAIC ACVC 2.0 +-- +--! + +generic -- Mathematical group signature. + + type Group_Type is private; + + Identity : in Group_Type; + + with function Operation (Left, Right : Group_Type) return Group_Type; +-- with function Inverse... (omitted for brevity). + +package CC70002_0 is + + function Power (Left : Group_Type; Right : Integer) return Group_Type; + + -- ... Other group operations. + +end CC70002_0; + + + --==================================================================-- + + +package body CC70002_0 is + + -- The implementation of Power is purely artificial; the validity of its + -- implementation in the context of the abstraction is irrelevant to the + -- feature being tested. + + function Power (Left : Group_Type; Right : Integer) return Group_Type is + Result : Group_Type := Identity; + begin + Result := Operation (Result, Left); -- All this really does is add + return Result; -- one to each matrix element. + end Power; + +end CC70002_0; + + + --==================================================================-- + + +generic -- 2D matrix abstraction. + type Element_Type is range <>; + + type Abscissa is range <>; + type Ordinate is range <>; + + type Matrix_2D is array (Abscissa, Ordinate) of Element_Type; +package CC70002_1 is + + Add_Ident : constant Matrix_2D := (Abscissa => (others => 1)); + -- Artificial for + -- testing purposes. + -- ... Other identity matrices. + + + function "+" (A, B : Matrix_2D) return Matrix_2D; + + -- ... Other operations. + +end CC70002_1; + + + --==================================================================-- + + +package body CC70002_1 is + + function "+" (A, B : Matrix_2D) return Matrix_2D is + C : Matrix_2D; + begin + for I in Abscissa loop + for J in Ordinate loop + C(I,J) := A(I,J) + B(I,J); + end loop; + end loop; + return C; + end "+"; + +end CC70002_1; + + + --==================================================================-- + + +with CC70002_0; -- Mathematical group signature. +with CC70002_1; -- 2D matrix abstraction. + +generic -- Mathematical 2D matrix addition group. + + with package Matrix_Ops is new CC70002_1 (<>); + + -- Although the restriction of the formal package below to signatures + -- describing addition groups, and then only for 2D matrices, is rather + -- artificial in the context of this "application," the passing of types, + -- objects, and subprograms as actuals to a formal package is not. + + with package Math_Sig is new CC70002_0 + (Group_Type => Matrix_Ops.Matrix_2D, + Identity => Matrix_Ops.Add_Ident, + Operation => Matrix_Ops."+"); + +package CC70002_2 is + + -- Add two matrices that are to be multiplied by coefficients: + -- [ ] = CA*[ ] + CB*[ ]. + + function Add_Matrices_With_Coefficients (A : Matrix_Ops.Matrix_2D; + CA : Integer; + B : Matrix_Ops.Matrix_2D; + CB : Integer) + return Matrix_Ops.Matrix_2D; + + -- ...Other operations. + +end CC70002_2; + + + --==================================================================-- + + +package body CC70002_2 is + + function Add_Matrices_With_Coefficients (A : Matrix_Ops.Matrix_2D; + CA : Integer; + B : Matrix_Ops.Matrix_2D; + CB : Integer) + return Matrix_Ops.Matrix_2D is + Left, Right : Matrix_Ops.Matrix_2D; + begin + Left := Math_Sig.Power (A, CA); -- Multiply 1st array by its coeff. + Right := Math_Sig.Power (B, CB); -- Multiply 2nd array by its coeff. + return (Matrix_Ops."+" (Left, Right));-- Add these two arrays. + end Add_Matrices_With_Coefficients; + +end CC70002_2; + + + --==================================================================-- + + +with CC70002_0; -- Mathematical group signature. +with CC70002_1; -- 2D matrix abstraction. +with CC70002_2; -- Mathematical 2D matrix addition group. + +with Report; +procedure CC70002 is + + subtype Cell_Type is Positive range 1 .. 3; + subtype Category_Type is Positive range 1 .. 2; + + type Data_Points is new Natural range 0 .. 100; + + type Table_Type is array (Cell_Type, Category_Type) of Data_Points; + + package Data_Table_Support is new CC70002_1 (Data_Points, + Cell_Type, + Category_Type, + Table_Type); + + package Data_Table_Addition_Group is new CC70002_0 + (Group_Type => Table_Type, + Identity => Data_Table_Support.Add_Ident, + Operation => Data_Table_Support."+"); + + package Table_Add_Ops is new CC70002_2 + (Data_Table_Support, Data_Table_Addition_Group); + + + Scores_Table : Table_Type := ( ( 12, 0), + ( 21, 33), + ( 49, 9) ); + Expected : Table_Type := ( ( 26, 2), + ( 44, 68), + ( 100, 20) ); + +begin + Report.Test ("CC70002", "Check that a generic formal package actual " & + "part may specify formal objects, formal subprograms, " & + "and formal types"); + + Scores_Table := Table_Add_Ops.Add_Matrices_With_Coefficients + (Scores_Table, 2, + Scores_Table, 1); + + if (Scores_Table /= Expected) then + Report.Failed ("Incorrect result for multi-dimensional array"); + end if; + + Report.Result; +end CC70002; |