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

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