c95072b.ada

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

-- C95072B.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 PRIVATE TYPES IMPLEMENTED AS SCALAR OR ACCESS TYPES ARE
-- PASSED BY COPY FOR ALL MODES.
-- SUBTESTS ARE:
--   (A)  PRIVATE SCALAR PARAMETERS TO ENTRIES.
--   (B)  PRIVATE ACCESS PARAMETERS TO ENTRIES.

-- JWC 7/22/85

WITH REPORT; USE REPORT;
PROCEDURE C95072B IS

BEGIN
     TEST("C95072B", "CHECK THAT PRIVATE SCALAR AND ACCESS " &
                     "PARAMETERS ARE COPIED");

     ---------------------------------------------------

     DECLARE  -- (A)

          PACKAGE SCALAR_PKG IS

               TYPE T IS PRIVATE;
               C0 : CONSTANT T;
               C1 : CONSTANT T;
               C10 : CONSTANT T;
               C100 : CONSTANT T;

               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T;
               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER;

          PRIVATE

               TYPE T IS NEW INTEGER;
               C0 : CONSTANT T := 0;
               C1 : CONSTANT T := 1;
               C10 : CONSTANT T := 10;
               C100 : CONSTANT T := 100;

          END SCALAR_PKG;

          PACKAGE BODY SCALAR_PKG IS

               FUNCTION "+" (OLD : IN T; INCREMENT : IN T) RETURN T IS
               BEGIN
                    RETURN T (INTEGER(OLD) + INTEGER(INCREMENT));
               END "+";

               FUNCTION CONVERT (OLD_PRIVATE : IN T) RETURN INTEGER IS
               BEGIN
                    RETURN INTEGER (OLD_PRIVATE);
               END CONVERT;

          END SCALAR_PKG;

          USE SCALAR_PKG;

     BEGIN  -- (A)

          DECLARE  -- (A1)

               I : T;
               E : EXCEPTION;

               TASK TA IS
                    ENTRY EA (EI : IN T; EO : OUT T;
                              EIO : IN OUT T);
               END TA;

               TASK BODY TA IS

                    TEMP : T;

               BEGIN

                    ACCEPT EA (EI : IN T; EO : OUT T;
                               EIO : IN OUT T) DO

                         TEMP := EI;    -- SAVE VALUE OF EI AT ACCEPT.

                         EO := C10;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(SCALAR) OUT PARAMETER " &
                                      "CHANGES THE VALUE OF INPUT " &
                                      "PARAMETER");
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
                         END IF;

                         EIO := EIO + C100;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(SCALAR) IN OUT PARAMETER " &
                                      "CHANGES THE VALUE OF INPUT " &
                                      "PARAMETER");
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
                         END IF;

                         I := I + C1;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(SCALAR) ACTUAL PARAMETER " &
                                      "CHANGES THE VALUE OF " &
                                      "INPUT PARAMETER");
                         END IF;

                         RAISE E;              -- CHECK EXCEPTION
                                               -- HANDLING.
                    END EA;

               EXCEPTION
                    WHEN OTHERS => NULL;
               END TA;

          BEGIN    -- (A1)

               I := C0;  -- INITIALIZE I SO VARIOUS CASES CAN BE
                         -- DETECTED.
               TA.EA (I, I, I);
               FAILED ("EXCEPTION NOT RAISED - A");

          EXCEPTION
               WHEN E =>
                    IF I /= C1 THEN
                         CASE CONVERT (I) IS
                              WHEN 11 =>
                                   FAILED ("OUT ACTUAL PRIVATE " &
                                           "(SCALAR) PARAMETER " &
                                           "CHANGED GLOBAL VALUE");
                              WHEN 101 =>
                                   FAILED ("IN OUT ACTUAL PRIVATE " &
                                           "(SCALAR) PARAMETER " &
                                           "CHANGED GLOBAL VALUE");
                              WHEN 111 =>
                                   FAILED ("OUT AND IN OUT ACTUAL " &
                                           "PRIVATE (SCALAR) " &
                                           "PARAMETER CHANGED " &
                                           "GLOBAL VALUE");
                              WHEN OTHERS =>
                                   FAILED ("UNDETERMINED CHANGE TO " &
                                           "GLOBAL VALUE");
                         END CASE;
                    END IF;
               WHEN OTHERS =>
                    FAILED ("WRONG EXCEPTION RAISED - A");
          END;  -- (A1)

     END;  -- (A)

     ---------------------------------------------------

     DECLARE  -- (B)

          PACKAGE ACCESS_PKG IS

               TYPE T IS PRIVATE;
               C_NULL : CONSTANT T;
               C1 : CONSTANT T;
               C10 : CONSTANT T;
               C100 : CONSTANT T;
               C101 : CONSTANT T;

          PRIVATE

               TYPE T IS ACCESS INTEGER;
               C_NULL : CONSTANT T := NULL;
               C1 : CONSTANT T := NEW INTEGER'(1);
               C10 : CONSTANT T := NEW INTEGER'(10);
               C100 : CONSTANT T := NEW INTEGER'(100);
               C101 : CONSTANT T := NEW INTEGER'(101);

          END ACCESS_PKG;

          USE ACCESS_PKG;

     BEGIN    -- (B)

          DECLARE  -- (B1)

               I : T;
               E : EXCEPTION;

               TASK TB IS
                    ENTRY EB (EI : IN T; EO : OUT T;
                              EIO : IN OUT T);
               END TB;

               TASK BODY TB IS

                    TEMP : T;

               BEGIN

                    ACCEPT EB (EI : IN T; EO : OUT T;
                               EIO : IN OUT T) DO

                         TEMP := EI;  -- SAVE VALUE OF EI AT ACCEPT.

                         I := C101;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(ACCESS) ACTUAL VARIABLE " &
                                      "CHANGES THE VALUE OF INPUT " &
                                      "PARAMETER");
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
                         END IF;

                         EO := C1;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(ACCESS) OUT PARAMETER " &
                                      "CHANGES THE VALUE OF INPUT " &
                                      "PARAMETER");
                              TEMP := EI;   -- RESET TEMP FOR NEXT CASE.
                         END IF;

                         EIO := C10;
                         IF EI /= TEMP THEN
                              FAILED ("ASSIGNMENT TO PRIVATE " &
                                      "(ACCESS) IN OUT PARAMETER " &
                                      "CHANGES THE VALUE OF INPUT " &
                                      "PARAMETER");
                         END IF;

                         RAISE E;                 -- CHECK EXCEPTION
                                                  -- HANDLING.
                    END EB;

               EXCEPTION
                    WHEN OTHERS => NULL;
               END TB;

          BEGIN     -- (B1)

               I := C100;
               TB.EB (I, I, I);
               FAILED ("EXCEPTION NOT RAISED - B");

          EXCEPTION
               WHEN E =>
                    IF I /= C101 THEN
                         FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
                                 "PARAMETER VALUE CHANGED DESPITE " &
                                 "RAISED EXCEPTION");
                    END IF;
               WHEN OTHERS =>
                    FAILED ("WRONG EXCEPTION RAISED - B");
          END;  -- (B1)

     END;  -- (B)

     ---------------------------------------------------

     RESULT;
END C95072B;