cd2a31c.ada

来自「linux下编程用 编译软件」· ADA 代码 · 共 128 行

-- CD2A31C.ADA

--                             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 INTEGER 'SIZE SPECIFICATIONS CAN BE GIVEN:
--        IN THE VISIBLE OR PRIVATE PART OF A PACKAGE FOR A TYPE
--          DECLARED IN THE VISIBLE PART;
--        FOR A DERIVED INTEGER TYPE;
--        FOR A DERIVED PRIVATE TYPE WHOSE FULL DECLARATION IS AS
--          AN INTEGER TYPE;
--        FOR AN INTEGER TYPE IN A GENERIC UNIT.

-- HISTORY:
--     PWB 06/17/87  CREATED ORIGINAL TEST.
--     DHH 04/06/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
--                   SIZE CLAUSE VALUE TO 9, AND ADDED REPRESENTAION
--                   CLAUSE CHECK AND INCLUDED TEST FOR INTEGER IN A
--                   GENERIC UNIT.
--     JRL 03/27/92  REMOVED TESTING OF NONOBJECTIVE TYPES.
--     DTN 06/17/92  REMOVED THE LENGTH CLAUSE FOR TYPE PRIVATE_INT.

WITH REPORT; USE REPORT;
WITH LENGTH_CHECK;                      -- CONTAINS A CALL TO 'FAILED'.
PROCEDURE CD2A31C IS

     TYPE BASIC_INT IS RANGE -60 .. 80;
     SPECIFIED_SIZE : CONSTANT := 9;

     TYPE DERIVED_INT IS NEW BASIC_INT;
     FOR DERIVED_INT'SIZE USE SPECIFIED_SIZE;

     PACKAGE P IS
          TYPE INT_IN_P IS RANGE -125 .. 125;
          FOR INT_IN_P'SIZE USE SPECIFIED_SIZE;
          TYPE PRIVATE_INT IS PRIVATE;
          TYPE ALT_INT_IN_P IS RANGE -125 .. 125;
     PRIVATE
          TYPE PRIVATE_INT IS RANGE -125 .. 125;
          FOR ALT_INT_IN_P'SIZE USE SPECIFIED_SIZE;
     END P;

     USE P;
     TYPE DERIVED_PRIVATE_INT IS NEW PRIVATE_INT;
     FOR DERIVED_PRIVATE_INT'SIZE USE SPECIFIED_SIZE;
     MINIMUM_SIZE : INTEGER := IDENT_INT(SPECIFIED_SIZE);

-- SIZE SPECIFICATION GIVEN IN A GENERIC PROCEDURE.

     GENERIC
     PROCEDURE GENPROC;

     PROCEDURE GENPROC IS
          TYPE CHECK_INT IS RANGE -125 .. 125;
          FOR CHECK_INT'SIZE USE SPECIFIED_SIZE;

          PROCEDURE CHECK_4 IS NEW LENGTH_CHECK (CHECK_INT);

     BEGIN

          IF CHECK_INT'SIZE /= MINIMUM_SIZE THEN
               FAILED ("GENERIC CHECK_INT'SIZE IS INCORRECT");
          END IF;
          CHECK_4 (-60, 9, "GENERIC CHECK_INT");

     END GENPROC;

     PROCEDURE NEWPROC IS NEW GENPROC;

     PROCEDURE CHECK_1 IS NEW LENGTH_CHECK (DERIVED_INT);
     PROCEDURE CHECK_2 IS NEW LENGTH_CHECK (INT_IN_P);
     PROCEDURE CHECK_3 IS NEW LENGTH_CHECK (ALT_INT_IN_P);

BEGIN

     TEST("CD2A31C", "CHECK THAT 'SIZE SPECIFICATIONS CAN BE GIVEN IN " &
                     "VISIBLE OR PRIVATE PART OF PACKAGE FOR INTEGER " &
                     "TYPE DECLARED IN VISIBLE PART, AND FOR " &
                     "DERIVED INTEGER TYPES " &
                     "AND DERIVED PRIVATE TYPES WHOSE FULL DECLARATIONS " &
                     "ARE AS INTEGER TYPES");

     CHECK_1 (-60, 9, "DERIVED_INT");
     CHECK_2 (-60, 9, "INT_IN_P");
     CHECK_3 (-60, 9, "ALT_INT_IN_P");

     NEWPROC;

     IF DERIVED_INT'SIZE /= MINIMUM_SIZE THEN
          FAILED ("DERIVED_INT'SIZE INCORRECT");
     END IF;

     IF INT_IN_P'SIZE /= MINIMUM_SIZE THEN
          FAILED ("INT_IN_P'SIZE INCORRECT");
     END IF;

     IF ALT_INT_IN_P'SIZE /= MINIMUM_SIZE THEN
          FAILED ("ALT_INT_IN_P'SIZE INCORRECT");
     END IF;

     IF DERIVED_PRIVATE_INT'SIZE /= MINIMUM_SIZE THEN
          FAILED ("DERIVED_PRIVATE_INT'SIZE INCORRECT");
     END IF;

     RESULT;

END CD2A31C;