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

   1 -- C95087D.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 ASSIGNMENTS TO ENTRY FORMAL PARAMETERS OF UNCONSTRAINED
  26 --    RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITH DEFAULT
  27 --    CONSTRAINTS DO NOT RAISE CONSTRAINT_ERROR IF THE ACTUAL PARAMETER
  28 --    IS UNCONSTRAINED, EVEN IF THE CONSTRAINT VALUES OF THE OBJECT
  29 --    BEING ASSIGNED ARE DIFFERENT THAN THOSE OF THE ACTUAL PARAMETER.
  30
  31 --    SUBTESTS ARE:
  32 --        (A) UNCONSTRAINED ACTUAL PARAMETERS OF RECORD TYPE.
  33 --        (B) UNCONSTRAINED ACTUAL PARAMETERS OF PRIVATE TYPE.
  34 --        (C) UNCONSTRAINED ACTUAL PARAMETERS OF LIMITED PRIVATE TYPE.
  35
  36 -- RJW  1/17/86
  37
  38 WITH REPORT; USE REPORT;
  39 PROCEDURE C95087D IS
  40
  41 BEGIN
  42
  43      TEST ( "C95087D", "CHECK ASSIGNMENTS TO ENTRY FORMAL PARAMETERS " &
  44                        "OF UNCONSTRAINED TYPES WITH UNCONSTRAINED " &
  45                        "ACTUAL PARAMETERS");
  46
  47      --------------------------------------------------
  48
  49      DECLARE  -- (A)
  50
  51           PACKAGE PKG IS
  52
  53                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
  54
  55                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
  56                     RECORD
  57                          INTFLD   : INTRANGE;
  58                          STRFLD   : STRING(1..CONSTRAINT);
  59                     END RECORD;
  60
  61                TASK T IS
  62                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
  63                              REC3 : OUT RECTYPE);
  64                END T;
  65
  66           END PKG;
  67
  68           REC91, REC92, REC93 : PKG.RECTYPE :=
  69                (IDENT_INT(5), 5, IDENT_STR( "12345"));
  70           REC_OOPS            : PKG.RECTYPE;
  71
  72           PACKAGE BODY PKG IS
  73
  74                TASK BODY T IS
  75                BEGIN
  76                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
  77                               REC3 : OUT RECTYPE) DO
  78
  79                          IF NOT REC1'CONSTRAINED THEN
  80                               FAILED ( "REC1 IS NOT CONSTRAINED - A.1");
  81                          END IF;
  82                          IF REC1.CONSTRAINT /= IDENT_INT(9) THEN
  83                               FAILED ( "REC1 CONSTRAINT IS NOT 9 " &
  84                                  "- A.1");
  85                          END IF;
  86
  87                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
  88                               REC2 := REC_OOPS;
  89                          EXCEPTION
  90                               WHEN OTHERS =>
  91                                    FAILED ( "EXCEPTION RAISED - A.1");
  92                          END;
  93
  94                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
  95                               REC3 := REC_OOPS;
  96                          EXCEPTION
  97                               WHEN OTHERS =>
  98                                    FAILED ( "EXCEPTION RAISED - A.2");
  99                          END;
 100
 101                     END E;
 102                END T;
 103
 104           BEGIN
 105
 106                REC91 := (9, 9, "123456789");
 107                REC92 := REC91;
 108                REC93 := REC91;
 109
 110                REC_OOPS := (4, 4, "OOPS");
 111
 112           END PKG;
 113
 114           USE PKG;
 115
 116      BEGIN  -- (A)
 117
 118           PKG.T.E  (REC91, REC92, REC93);
 119           IF (REC92 /= REC_OOPS) OR (REC93 /= REC_OOPS) THEN
 120                FAILED ( "RESULTANT VALUE OF REC92 OR REC93 INCORRECT");
 121           END IF;
 122
 123      END;   -- (A)
 124
 125      --------------------------------------------------
 126
 127      DECLARE  -- (B)
 128
 129           PACKAGE PKG IS
 130
 131                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
 132
 133                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS PRIVATE;
 134
 135                TASK T IS
 136                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
 137                              REC3 : OUT RECTYPE);
 138                END T;
 139
 140           PRIVATE
 141
 142                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
 143                     RECORD
 144                          INTFLD   : INTRANGE;
 145                          STRFLD   : STRING(1..CONSTRAINT);
 146                     END RECORD;
 147           END PKG;
 148
 149           REC91, REC92, REC93  : PKG.RECTYPE;
 150           REC_OOPS             : PKG.RECTYPE;
 151
 152           PACKAGE BODY PKG IS
 153
 154                TASK BODY T IS
 155                BEGIN
 156                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
 157                               REC3 : OUT RECTYPE) DO
 158
 159                          IF REC3'CONSTRAINED THEN
 160                               FAILED ( "REC3 IS CONSTRAINED - B.1");
 161                          END IF;
 162
 163                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
 164                               REC2 := REC_OOPS;
 165                          EXCEPTION
 166                               WHEN OTHERS =>
 167                                    FAILED ( "EXCEPTION RAISED - B.1");
 168                          END;
 169
 170                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
 171                               REC3 := REC_OOPS;
 172                          EXCEPTION
 173                               WHEN OTHERS =>
 174                                    FAILED ( "EXCEPTION RAISED - B.2");
 175                          END;
 176
 177                     END E;
 178                END T;
 179
 180           BEGIN
 181
 182                REC91 := (9, 9, "123456789");
 183                REC92 := REC91;
 184                REC93 := REC91;
 185
 186                REC_OOPS := (4, 4, "OOPS");
 187
 188           END PKG;
 189
 190      BEGIN  -- (B)
 191
 192           PKG.T.E (REC91, REC92, REC93);
 193
 194      END;   -- (B)
 195
 196      --------------------------------------------------
 197
 198      DECLARE  -- (C)
 199
 200           PACKAGE PKG IS
 201
 202                SUBTYPE INTRANGE IS INTEGER RANGE 0..31;
 203
 204                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
 205                     LIMITED PRIVATE;
 206
 207                TASK T IS
 208                     ENTRY E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
 209                              REC3 : OUT RECTYPE);
 210                END T;
 211
 212           PRIVATE
 213
 214                TYPE RECTYPE (CONSTRAINT : INTRANGE := 15) IS
 215                     RECORD
 216                          INTFLD   : INTRANGE;
 217                          STRFLD   : STRING(1..CONSTRAINT);
 218                     END RECORD;
 219           END PKG;
 220
 221           REC91, REC92, REC93  : PKG.RECTYPE;
 222           REC_OOPS             : PKG.RECTYPE;
 223
 224           PACKAGE BODY PKG IS
 225
 226                TASK BODY T IS
 227                BEGIN
 228                     ACCEPT E (REC1 : IN RECTYPE; REC2 : IN OUT RECTYPE;
 229                               REC3 : OUT RECTYPE) DO
 230
 231                          BEGIN  -- ASSIGNMENT TO IN OUT PARAMETER.
 232                               REC2 := REC_OOPS;
 233                          EXCEPTION
 234                               WHEN OTHERS =>
 235                                    FAILED ( "EXCEPTION RAISED - C.1");
 236                          END;
 237
 238                          BEGIN  -- ASSIGNMENT TO OUT PARAMETER.
 239                               REC3 := REC_OOPS;
 240                          EXCEPTION
 241                               WHEN OTHERS =>
 242                                    FAILED ( "EXCEPTION RAISED - C.2");
 243                          END;
 244
 245                     END E;
 246                END T;
 247
 248           BEGIN
 249
 250                REC91 := (9, 9, "123456789");
 251                REC92 := REC91;
 252                REC93 := REC91;
 253
 254                REC_OOPS := (4, 4, "OOPS");
 255
 256           END PKG;
 257
 258      BEGIN  -- (C)
 259
 260           PKG.T.E (REC91, REC92, REC93);
 261
 262      END;   -- (C)
 263
 264      --------------------------------------------------
 265
 266      RESULT;
 267
 268 END C95087D;