Subversion Repositories scarts

-- C95071A.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 OBJECTS DESIGNATED BY IN PARAMETERS OF ACCESS TYPES CAN

-- BE USED AS THE TARGET OF AN ASSIGNMENT STATEMENT AND AS AN ACTUAL

-- PARAMETER OF ANY MODE.  SUBTESTS ARE:

--        (A) INTEGER ACCESS TYPE.

--        (B) ARRAY ACCESS TYPE.

--        (C) RECORD ACCESS TYPE.

-- JWC 7/11/85

WITH REPORT; USE REPORT;

PROCEDURE C95071A IS

BEGIN

     TEST ("C95071A", "CHECK THAT COMPONENTS OF ACCESS IN PARAMETERS " &

                      "MAY BE USED IN ASSIGNMENT CONTEXTS");

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

     DECLARE   -- (A)

          TYPE PTRINT IS ACCESS INTEGER;

          PI : PTRINT;

          TASK TA IS

               ENTRY EA (PI : IN PTRINT);

          END TA;

          TASK BODY TA IS

          BEGIN

               ACCEPT EA (PI : IN PTRINT) DO

                    DECLARE

                         TASK TA1 IS

                              ENTRY EA1 (I : OUT INTEGER);

                              ENTRY EA2 (I : IN OUT INTEGER);

                         END TA1;

                         TASK BODY TA1 IS

                         BEGIN

                              ACCEPT EA1 (I : OUT INTEGER) DO

                                   I := 7;

                              END EA1;

                              ACCEPT EA2 (I : IN OUT INTEGER) DO

                                   I := I + 1;

                              END EA2;

                         END TA1;

                    BEGIN

                         TA1.EA1 (PI.ALL);

                         TA1.EA2 (PI.ALL);

                         PI.ALL := PI.ALL + 1;

                         IF (PI.ALL /= 9) THEN

                              FAILED ("ASSIGNMENT TO COMPONENT OF " &

                                      "INTEGER ACCESS PARAMETER " &

                                      "FAILED");

                         END IF;

                    END;

               END EA;

          END TA;

     BEGIN     -- (A)

          PI := NEW INTEGER'(0);

          TA.EA (PI);

     END;      -- (A)

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

     DECLARE   -- (B)

          TYPE TBL IS ARRAY (1..3) OF INTEGER;

          TYPE PTRTBL IS ACCESS TBL;

          PT : PTRTBL;

          TASK TB IS

               ENTRY EB (PT : IN PTRTBL);

          END TB;

          TASK BODY TB IS

          BEGIN

               ACCEPT EB (PT : IN PTRTBL) DO

                    DECLARE

                         TASK TB1 IS

                              ENTRY EB1 (T : OUT TBL);

                              ENTRY EB2 (T : IN OUT TBL);

                              ENTRY EB3 (I : OUT INTEGER);

                              ENTRY EB4 (I : IN OUT INTEGER);

                         END TB1;

                         TASK BODY TB1 IS

                         BEGIN

                              ACCEPT EB1 (T : OUT TBL) DO

                                   T := (1,2,3);

                              END EB1;

                              ACCEPT EB2 (T : IN OUT TBL) DO

                                   T(3) := T(3) - 1;

                              END EB2;

                              ACCEPT EB3 (I : OUT INTEGER) DO

                                   I := 7;

                              END EB3;

                              ACCEPT EB4 (I : IN OUT INTEGER) DO

                                   I := I + 1;

                              END EB4;

                         END TB1;

                    BEGIN

                         TB1.EB1 (PT.ALL);         -- (1,2,3)

                         TB1.EB2 (PT.ALL);         -- (1,2,2)

                         TB1.EB3 (PT(2));          -- (1,7,2)

                         TB1.EB4 (PT(1));          -- (2,7,2)

                         PT(3) := PT(3) + 7;      -- (2,7,9)

                         IF (PT.ALL /= (2,7,9)) THEN

                              FAILED ("ASSIGNMENT TO COMPONENT OF " &

                                      "ARRAY ACCESS PARAMETER FAILED");

                         END IF;

                    END;

               END EB;

          END TB;

     BEGIN     -- (B)

          PT := NEW TBL'(0,0,0);

          TB.EB (PT);

     END;      -- (B)

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

     DECLARE   -- (C)

          TYPE REC IS

               RECORD

                    I1   : INTEGER;

                    I2   : INTEGER;

                    I3   : INTEGER;

               END RECORD;

          TYPE PTRREC IS ACCESS REC;

          PR : PTRREC;

          TASK TC IS

               ENTRY EC (PR : IN PTRREC);

          END TC;

          TASK BODY TC IS

          BEGIN

               ACCEPT EC (PR : IN PTRREC) DO

                    DECLARE

                         TASK TC1 IS

                              ENTRY EC1 (R : OUT REC);

                              ENTRY EC2 (R : IN OUT REC);

                              ENTRY EC3 (I : OUT INTEGER);

                              ENTRY EC4 (I : IN OUT INTEGER);

                         END TC1;

                         TASK BODY TC1 IS

                         BEGIN

                              ACCEPT EC1 (R : OUT REC) DO

                                   R := (1,2,3);

                              END EC1;

                              ACCEPT EC2 (R : IN OUT REC) DO

                                   R.I3 := R.I3 - 1;

                              END EC2;

                              ACCEPT EC3 (I : OUT INTEGER) DO

                                   I := 7;

                              END  EC3;

                              ACCEPT EC4 (I : IN OUT INTEGER) DO

                                   I := I + 1;

                              END EC4;

                         END TC1;

                    BEGIN

                         TC1.EC1 (PR.ALL);         -- (1,2,3)

                         TC1.EC2 (PR.ALL);         -- (1,2,2)

                         TC1.EC3 (PR.I2);          -- (1,7,2)

                         TC1.EC4 (PR.I1);          -- (2,7,2)

                         PR.I3 := PR.I3 + 7;       -- (2,7,9)

                         IF (PR.ALL /= (2,7,9)) THEN

                              FAILED ("ASSIGNMENT TO COMPONENT OF " &

                                      "RECORD ACCESS PARAMETER " &

                                      "FAILED");

                         END IF;

                    END;

               END EC;

          END TC;

     BEGIN     -- (C)

          PR := NEW REC'(0,0,0);

          TC.EC (PR);

     END;      -- (C)

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

     RESULT;

END C95071A;