c49023a.ada

来自「用于进行gcc测试」· ADA 代码 · 共 118 行

-- C49023A.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.
--*
-- CHECK THAT A CONSTANT DECLARED BY AN OBJECT DECLARATION CAN BE USED
-- IN A STATIC EXPRESSION IF THE CONSTANT WAS DECLARED WITH A STATIC
-- SUBTYPE AND INITIALIZED WITH A STATIC EXPRESSION.

-- L.BROWN  10/01/86

WITH REPORT; USE REPORT;
PROCEDURE  C49023A  IS

BEGIN
     TEST("C49023A","A CONSTANT DECLARED BY AN OBJECT DECLARATION "&
                    "UNDER CERTAIN CONDITIONS CAN BE USED IN A "&
                    "STATIC EXPRESSION");
     DECLARE
          TYPE ENUM IS (RED,GREEN,BLUE,YELLOW);
          SUBTYPE SENUM IS ENUM RANGE RED .. BLUE;
          CONEN : CONSTANT SENUM := GREEN;
          TYPE INT IS RANGE 1 .. 10;
          SUBTYPE SINT IS INT RANGE 1 .. 5;
          CONIN : CONSTANT SINT := 3;
          TYPE FLT IS DIGITS 3 RANGE 0.0 .. 25.0;
          SUBTYPE SFLT IS FLT RANGE 10.0 .. 20.0;
          CONFL : CONSTANT SFLT := 11.0;
          TYPE FIX IS DELTA 0.25 RANGE 0.0 .. 25.0;
          SUBTYPE SFIX IS FIX RANGE 0.0 .. 12.0;
          CONFI : CONSTANT SFIX := 0.25;
          CAS_EN : ENUM := CONEN;
          TYPE ITEG IS RANGE 1 .. CONIN;
          TYPE FLTY IS DIGITS CONIN;
          TYPE FIXY IS DELTA CONFI RANGE 0.0 .. 10.0;
          TYPE REAL IS DELTA 0.25 RANGE 0.0 .. 11.0;
          TYPE FIXTY IS DELTA 0.25 RANGE 0.0 .. CONFL;

          FUNCTION IDENT_REAL (X : REAL) RETURN REAL;

          PACKAGE P IS
               TYPE T IS PRIVATE;
               CON1 : CONSTANT T;
          PRIVATE
               TYPE T IS NEW INTEGER;
               CON1 : CONSTANT T := 10;
               TYPE NINT IS RANGE 1 .. CON1;
          END P;
          PACKAGE BODY P IS
               TYPE CON2 IS RANGE CON1 .. 50;
          BEGIN
               IF NINT'LAST /= NINT(IDENT_INT(10)) THEN
                    FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 1");
               END IF;
               IF CON2'FIRST /= CON2(IDENT_INT(10)) THEN
                    FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 2");
               END IF;
          END P;

          FUNCTION IDENT_REAL (X : REAL) RETURN REAL IS
          BEGIN
               IF EQUAL(3,3) THEN
                    RETURN X;
               ELSE
                    RETURN 0.0;
               END IF;
          END IDENT_REAL;

     BEGIN

          IF ITEG'LAST /= ITEG(IDENT_INT(3))  THEN
               FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 3");
          END IF;

          IF FLTY'DIGITS /= IDENT_INT(3)  THEN
               FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 4");
          END IF;

          IF FIXY'DELTA /= IDENT_REAL(0.25)  THEN
               FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 5");
          END IF;

          IF FIXTY'LAST /= FIXTY(IDENT_REAL(11.0)) THEN
               FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 6");
          END IF;

          CASE CAS_EN IS
               WHEN CONEN =>
                    CAS_EN := RED;
               WHEN OTHERS =>
                    FAILED("INCORRECT VALUE FOR STATIC EXPRESSION 7");
          END CASE;

     END;

     RESULT;

END C49023A;