old-autovect-branch/gcc/testsuite/ada/acats/tests/c3/c36204b.ada

   1 -- C36204B.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 -- OBJECTIVE:
  26 --     CHECK THAT EACH ARRAY ATTRIBUTE YIELDS THE CORRECT VALUES WITH
  27 --     ACCESS VALUES AND FUNCTION CALLS AS THE PREFIXES.
  28
  29 -- HISTORY:
  30 --     L.BROWN   08/05/86
  31 --     DWC  07/24/87  DELETED BLANK AT END OF TEST DESCRIPTION.
  32
  33 WITH REPORT; USE REPORT;
  34
  35 PROCEDURE C36204B IS
  36
  37      BEGIN
  38           TEST("C36204B", "ARRAY ATTRIBUTES RETURN CORRECT VALUES " &
  39                           "FOR ACCESS VALUES AND FUNCTION CALLS AS " &
  40                           "PREFIXES");
  41           DECLARE
  42                TYPE ARR1 IS ARRAY (INTEGER RANGE IDENT_INT(1) ..
  43                                    IDENT_INT(10)) OF INTEGER ;
  44                TYPE ARR2 IS ARRAY (BOOLEAN,
  45                                    INTEGER RANGE IDENT_INT(1) ..
  46                                    IDENT_INT(3)) OF INTEGER ;
  47
  48                TYPE PTR1 IS ACCESS ARR1;
  49                TYPE PTR2 IS ACCESS ARR2;
  50
  51                PT1 : PTR1 := NEW ARR1'(ARR1'RANGE => 0);
  52                PT2 : PTR2 := NEW ARR2'(ARR2'RANGE(1) =>
  53                                       (ARR2'RANGE(2) => 0));
  54                SUBTYPE ARR1_RANGE IS INTEGER RANGE PT1'RANGE;
  55           BEGIN
  56                IF PT1'FIRST /= IDENT_INT(1) THEN
  57                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
  58                            "ARRAY USING ACCESS TYPES AS PREFIXES 1");
  59                END IF;
  60
  61                IF PT2'FIRST(2) /= IDENT_INT(1)  THEN
  62                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
  63                            "ARRAY USING ACCESS TYPES AS PREFIXES 1");
  64                END IF;
  65
  66                IF ARR1_RANGE'FIRST /= IDENT_INT(1) THEN
  67                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
  68                            "ARRAY USING ACCESS TYPES AS PREFIXES 2");
  69                END IF;
  70
  71                IF PT1'LAST /= IDENT_INT(10) THEN
  72                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
  73                            "ARRAY USING ACCESS TYPES AS PREFIXES 3");
  74                END IF;
  75
  76                IF PT2'LAST(2) /= IDENT_INT(3)  THEN
  77                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
  78                            "ARRAY USING ACCESS TYPES AS PREFIXES 2");
  79                END IF;
  80
  81                IF ARR1_RANGE'LAST /= IDENT_INT(10) THEN
  82                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
  83                            "ARRAY USING ACCESS TYPES AS PREFIXES 4");
  84                END IF;
  85
  86                IF PT1'LENGTH /= IDENT_INT(10) THEN
  87                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
  88                            "ARRAY USING ACCESS TYPES AS PREFIXES 5");
  89                END IF;
  90
  91                IF PT2'LENGTH(2) /= IDENT_INT(3)  THEN
  92                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
  93                            "ARRAY USING ACCESS TYPES AS PREFIXES 3");
  94                END IF;
  95
  96           END;
  97
  98           DECLARE
  99
 100                TYPE UNCON IS ARRAY (INTEGER RANGE <>) OF INTEGER ;
 101                TYPE UNCON2 IS ARRAY (INTEGER RANGE <>,
 102                                      INTEGER RANGE <>) OF INTEGER ;
 103
 104                ARY1 : STRING(IDENT_INT(5) .. IDENT_INT(8));
 105                F : INTEGER := IDENT_INT(1);
 106                L : INTEGER := IDENT_INT(3);
 107
 108                FUNCTION FUN( LO,HI : INTEGER ) RETURN UNCON IS
 109                     ARR : UNCON(IDENT_INT(LO) .. IDENT_INT(HI));
 110                     BEGIN
 111                          ARR := (ARR'RANGE => 0);
 112                          RETURN ARR;
 113                     END FUN;
 114
 115                FUNCTION FUN2( LO,HI : INTEGER ) RETURN UNCON2 IS
 116                     AR2 : UNCON2(IDENT_INT(LO) .. IDENT_INT(HI),
 117                                  IDENT_INT(LO) .. IDENT_INT(HI));
 118                     BEGIN
 119                          AR2 := (AR2'RANGE(1) =>(AR2'RANGE(2) => 0));
 120                          RETURN AR2;
 121                     END FUN2;
 122           BEGIN
 123
 124                ARY1 := (ARY1'RANGE => 'A');
 125
 126                IF FUN(F,L)'FIRST /= IDENT_INT(1)  THEN
 127                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
 128                            "ARRAY USING FUNCTION RESULTS AS " &
 129                            "PREFIXES 1");
 130                END IF;
 131
 132                IF FUN2(F,L)'FIRST(2) /= IDENT_INT(1)  THEN
 133                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
 134                            "ARRAY USING FUNCTION RESULTS AS " &
 135                            "PREFIXES 1");
 136                END IF;
 137
 138                IF "&"(ARY1,"XX")'FIRST /= IDENT_INT(5)  THEN
 139                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
 140                            "ARRAY USING FUNCTION RESULTS AS " &
 141                            "PREFIXES 2");
 142                END IF;
 143
 144                IF FUN(F,L)'LAST /= IDENT_INT(3)  THEN
 145                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
 146                            "ARRAY USING FUNCTION RESULTS AS " &
 147                            "PREFIXES 3");
 148                END IF;
 149
 150                IF FUN2(F,L)'LAST(2) /= IDENT_INT(3)  THEN
 151                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
 152                            "ARRAY USING FUNCTION RESULTS AS " &
 153                            "PREFIXES 2");
 154                END IF;
 155
 156                IF "&"(ARY1,"YY")'LAST /= IDENT_INT(10)  THEN
 157                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
 158                            "ARRAY USING FUNCTION RESULTS AS " &
 159                            "PREFIXES 4");
 160                END IF;
 161
 162                IF FUN(F,L)'LENGTH /= IDENT_INT(3) THEN
 163                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
 164                            "ARRAY USING FUNCTION RESULTS AS " &
 165                            "PREFIXES 5");
 166                END IF;
 167
 168                IF FUN2(F,L)'LENGTH(2) /= IDENT_INT(3)  THEN
 169                     FAILED("INCORRECT ATTRIBUTE VALUE FOR TWO-DIM " &
 170                            "ARRAY USING FUNCTION RESULTS AS " &
 171                            "PREFIXES 3");
 172                END IF;
 173
 174                IF "&"(ARY1,"XX")'LENGTH /= IDENT_INT(6)  THEN
 175                     FAILED("INCORRECT ATTRIBUTE VALUE FOR ONE-DIM " &
 176                            "ARRAY USING FUNCTION RESULTS AS " &
 177                            "PREFIXES 6");
 178                END IF;
 179
 180                DECLARE
 181
 182                     SUBTYPE SMIN IS INTEGER RANGE FUN(F,L)'RANGE;
 183                     SUBTYPE SMIN2 IS INTEGER RANGE FUN2(F,L)'RANGE(2);
 184                     SUBTYPE SMIN3 IS INTEGER RANGE "&"(ARY1,"YY")'RANGE;
 185
 186                BEGIN
 187                     IF SMIN'FIRST /= IDENT_INT(1)  THEN
 188                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
 189                                 "ONE-DIM ARRAY USING FUNCTION " &
 190                                 "RESULTS AS PREFIXES 7");
 191                     END IF;
 192
 193                     IF SMIN2'FIRST /= IDENT_INT(1)  THEN
 194                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
 195                                 "TWO-DIM ARRAY USING FUNCTION " &
 196                                 "RESULTS AS PREFIXES 4");
 197                     END IF;
 198
 199                     IF SMIN3'FIRST /= IDENT_INT(5)  THEN
 200                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
 201                                 "ONE-DIM ARRAY USING FUNCTION " &
 202                                 "RESULTS AS PREFIXES 8");
 203                     END IF;
 204
 205                     IF SMIN'LAST /= IDENT_INT(3)  THEN
 206                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
 207                                 "ONE-DIM ARRAY USING FUNCTION " &
 208                                 "RESULTS AS PREFIXES 9");
 209                     END IF;
 210
 211                     IF SMIN2'LAST /= IDENT_INT(3)  THEN
 212                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
 213                                 "TWO-DIM ARRAY USING FUNCTION " &
 214                                 "RESULTS AS PREFIXES 5");
 215                     END IF;
 216
 217                     IF SMIN3'LAST /= IDENT_INT(10)  THEN
 218                          FAILED("INCORRECT ATTRIBUTE VALUE FOR " &
 219                                 "ONE-DIM ARRAY USING FUNCTION " &
 220                                 "RESULTS AS PREFIXES 10");
 221                     END IF;
 222
 223                END;
 224
 225           END;
 226
 227      RESULT;
 228
 229      END C36204B;