gcc/testsuite/ada/acats/tests/c9/c95072a.ada

   1 -- C95072A.ADA
   2
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 -- CHECK THAT SCALAR AND ACCESS PARAMETERS ARE COPIED FOR ALL THREE
  26 -- PARAMETER MODES.
  27 -- SUBTESTS ARE:
  28 --   (A)  SCALAR PARAMETERS TO ENTRIES.
  29 --   (B)  ACCESS PARAMETERS TO ENTRIES.
  30
  31 -- JWC 7/22/85
  32
  33 WITH REPORT; USE REPORT;
  34 PROCEDURE C95072A IS
  35
  36 BEGIN
  37      TEST ("C95072A", "CHECK THAT SCALAR AND ACCESS PARAMETERS ARE " &
  38                       "COPIED");
  39
  40      --------------------------------------------------
  41
  42      DECLARE  -- (A)
  43
  44           I : INTEGER;
  45           E : EXCEPTION;
  46
  47           TASK TA IS
  48                ENTRY EA (EI : IN INTEGER; EO : OUT INTEGER;
  49                          EIO : IN OUT INTEGER);
  50           END TA;
  51
  52           TASK BODY TA IS
  53
  54                TMP : INTEGER;
  55
  56           BEGIN
  57
  58                ACCEPT EA (EI : IN INTEGER; EO : OUT INTEGER;
  59                           EIO : IN OUT INTEGER) DO
  60
  61                     TMP := EI;     -- SAVE VALUE OF EI AT ACCEPT.
  62
  63                     EO := 10;
  64                     IF EI /= TMP THEN
  65                          FAILED ("ASSIGNMENT TO SCALAR OUT " &
  66                                  "PARAMETER CHANGES THE VALUE OF " &
  67                                  "INPUT PARAMETER");
  68                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
  69                     END IF;
  70
  71                     EIO := EIO + 100;
  72                     IF EI /= TMP THEN
  73                          FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
  74                                  "PARAMETER CHANGES THE VALUE OF " &
  75                                  "INPUT PARAMETER");
  76                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
  77                     END IF;
  78
  79                     I := I + 1;
  80                     IF EI /= TMP THEN
  81                          FAILED ("ASSIGNMENT TO SCALAR ACTUAL " &
  82                                  "PARAMETER CHANGES THE VALUE OF " &
  83                                  "INPUT PARAMETER");
  84                     END IF;
  85
  86                     RAISE E;            -- CHECK EXCEPTION HANDLING.
  87                END EA;
  88
  89           EXCEPTION
  90                WHEN OTHERS => NULL;
  91           END TA;
  92
  93      BEGIN  -- (A)
  94
  95           I := 0;   -- INITIALIZE I SO VARIOUS CASES CAN BE DETECTED.
  96           TA.EA (I, I, I);
  97           FAILED ("EXCEPTION NOT RAISED - A");
  98
  99      EXCEPTION
 100           WHEN E =>
 101                IF I /= 1 THEN
 102                     CASE I IS
 103                          WHEN 11  =>
 104                               FAILED ("OUT ACTUAL SCALAR PARAMETER " &
 105                                       "CHANGED GLOBAL VALUE");
 106                          WHEN 101 =>
 107                               FAILED ("IN OUT ACTUAL SCALAR " &
 108                                       "PARAMETER CHANGED GLOBAL VALUE");
 109                          WHEN 111 =>
 110                               FAILED ("OUT AND IN OUT ACTUAL SCALAR " &
 111                                       "PARAMETERS CHANGED GLOBAL " &
 112                                       "VALUE");
 113                          WHEN OTHERS =>
 114                               FAILED ("UNDETERMINED CHANGE TO GLOBAL " &
 115                                       "VALUE");
 116                     END CASE;
 117                END IF;
 118           WHEN OTHERS =>
 119                FAILED ("WRONG EXCEPTION RAISED - A");
 120      END;  -- (A)
 121
 122      --------------------------------------------------
 123
 124      DECLARE  -- (B)
 125
 126           TYPE ACCTYPE IS ACCESS INTEGER;
 127
 128           I : ACCTYPE;
 129           E : EXCEPTION;
 130
 131           TASK TB IS
 132                ENTRY EB (EI : IN ACCTYPE; EO : OUT ACCTYPE;
 133                          EIO : IN OUT ACCTYPE);
 134           END TB;
 135
 136           TASK BODY TB IS
 137
 138                TMP : ACCTYPE;
 139
 140           BEGIN
 141
 142                ACCEPT EB (EI : IN ACCTYPE; EO : OUT ACCTYPE;
 143                           EIO : IN OUT ACCTYPE) DO
 144
 145                     TMP := EI;     -- SAVE VALUE OF EI AT ACCEPT.
 146
 147                     I := NEW INTEGER'(101);
 148                     IF EI /= TMP THEN
 149                          FAILED ("ASSIGNMENT TO ACCESS ACTUAL " &
 150                                  "PARAMETER CHANGES THE VALUE OF " &
 151                                  "INPUT PARAMETER");
 152                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
 153                     END IF;
 154
 155                     EO := NEW INTEGER'(1);
 156                     IF EI /= TMP THEN
 157                          FAILED ("ASSIGNMENT TO ACCESS OUT " &
 158                                  "PARAMETER CHANGES THE VALUE OF " &
 159                                  "INPUT PARAMETER");
 160                          TMP := EI;     -- RESET TMP FOR NEXT CASE.
 161                     END IF;
 162
 163                     EIO := NEW INTEGER'(10);
 164                     IF EI /= TMP THEN
 165                          FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
 166                                  "PARAMETER CHANGES THE VALUE OF " &
 167                                  "INPUT PARAMETER");
 168                     END IF;
 169
 170                     RAISE E;            -- CHECK EXCEPTION HANDLING.
 171                END EB;
 172
 173           EXCEPTION
 174                WHEN OTHERS => NULL;
 175           END TB;
 176
 177      BEGIN  -- (B)
 178
 179           I := NEW INTEGER'(100);
 180           TB.EB (I, I, I);
 181           FAILED ("EXCEPTION NOT RAISED - B");
 182
 183      EXCEPTION
 184           WHEN E =>
 185                IF I.ALL /= 101 THEN
 186                     FAILED ("OUT OR IN OUT ACTUAL ENTRY " &
 187                             "PARAMETER VALUE CHANGED DESPITE " &
 188                             "RAISED EXCEPTION");
 189                END IF;
 190           WHEN OTHERS =>
 191                FAILED ("WRONG EXCEPTION RAISED - B");
 192      END;  -- (B)
 193
 194      --------------------------------------------------
 195
 196      RESULT;
 197 END C95072A;