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

   1 -- C32001E.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 IN MULTIPLE OBJECT DECLARATIONS FOR PRIVATE TYPES, THE
  26 -- SUBTYPE INDICATION AND THE INITIALIZATION EXPRESSIONS ARE EVALUATED
  27 -- ONCE FOR EACH NAMED OBJECT THAT IS DECLARED AND THE SUBTYPE
  28 -- INDICATION IS EVALUATED FIRST.  ALSO, CHECK THAT THE EVALUATIONS
  29 -- YIELD THE SAME RESULT AS A SEQUENCE OF SINGLE OBJECT DECLARATIONS.
  30
  31 -- RJW 7/18/86
  32
  33 WITH REPORT; USE REPORT;
  34
  35 PROCEDURE C32001E IS
  36
  37      BUMP : ARRAY (1 .. 10) OF INTEGER := (OTHERS => 0);
  38      G1 : ARRAY (5 .. 6) OF INTEGER;
  39
  40      FUNCTION F (I : INTEGER) RETURN INTEGER IS
  41      BEGIN
  42           BUMP (I) := BUMP (I) + 1;
  43           RETURN BUMP (I);
  44      END F;
  45
  46      FUNCTION G (I : INTEGER) RETURN INTEGER IS
  47      BEGIN
  48           BUMP (I) := BUMP (I) + 1;
  49           G1 (I) := BUMP (I);
  50           RETURN BUMP (I);
  51      END G;
  52
  53 BEGIN
  54      TEST ("C32001E", "CHECK THAT IN MULTIPLE OBJECT DECLARATIONS " &
  55                       "FOR PRIVATE TYPES, THE SUBTYPE INDICATION " &
  56                       "AND THE INITIALIZATION EXPRESSIONS ARE " &
  57                       "EVALUATED ONCE FOR EACH NAMED OBJECT THAT " &
  58                       "IS DECLARED AND THE SUBTYPE INDICATION IS " &
  59                       "EVALUATED FIRST.  ALSO, CHECK THAT THE " &
  60                       "EVALUATIONS YIELD THE SAME RESULT AS A " &
  61                       "SEQUENCE OF SINGLE OBJECT DECLARATIONS" );
  62
  63      DECLARE
  64           PACKAGE PKG1 IS
  65                TYPE PBOOL IS PRIVATE;
  66                TYPE PINT IS PRIVATE;
  67                TYPE PREC (D : INTEGER) IS PRIVATE;
  68                TYPE PARR IS PRIVATE;
  69                TYPE PACC IS PRIVATE;
  70
  71                FUNCTION INIT1 (I : INTEGER) RETURN PBOOL;
  72                FUNCTION INIT2 (I : INTEGER) RETURN PINT;
  73                FUNCTION INIT3 (I : INTEGER) RETURN PREC;
  74                FUNCTION INIT4 (I : INTEGER) RETURN PARR;
  75                FUNCTION INIT5 (I : INTEGER) RETURN PACC;
  76
  77                PROCEDURE CHECK1 (B : PBOOL; I : INTEGER; S : STRING);
  78                PROCEDURE CHECK2 (I : PINT;  J : INTEGER; S : STRING);
  79                PROCEDURE CHECK3 (R : PREC;  I, J : INTEGER;
  80                                  S : STRING);
  81                PROCEDURE CHECK4 (A : PARR;  I, J : INTEGER;
  82                                  S : STRING);
  83                PROCEDURE CHECK5 (V : PACC; S : STRING);
  84                PROCEDURE CHECK6 (V : PACC; S : STRING);
  85
  86           PRIVATE
  87                TYPE PBOOL IS NEW BOOLEAN;
  88                TYPE PINT IS NEW INTEGER;
  89
  90                TYPE PREC (D : INTEGER) IS
  91                     RECORD
  92                          VALUE : INTEGER;
  93                     END RECORD;
  94
  95                TYPE PARR IS ARRAY (1 .. 2) OF INTEGER;
  96
  97                TYPE VECTOR IS ARRAY (NATURAL RANGE <>) OF INTEGER;
  98                TYPE PACC IS ACCESS VECTOR;
  99           END PKG1;
 100
 101           PACKAGE BODY PKG1 IS
 102                FUNCTION INIT1 (I : INTEGER) RETURN PBOOL IS
 103                BEGIN
 104                     RETURN PBOOL'VAL (F (I) - 1);
 105                END INIT1;
 106
 107                FUNCTION INIT2 (I : INTEGER) RETURN PINT IS
 108                BEGIN
 109                     RETURN PINT'VAL (F (I));
 110                END INIT2;
 111
 112                FUNCTION INIT3 (I : INTEGER) RETURN PREC IS
 113                     PR : PREC (G1 (I)) := (G1 (I), F (I));
 114                BEGIN
 115                     RETURN PR;
 116                END INIT3;
 117
 118                FUNCTION INIT4 (I : INTEGER) RETURN PARR IS
 119                     PA : PARR := (1 .. 2 => F (I));
 120                BEGIN
 121                     RETURN PA;
 122                END INIT4;
 123
 124                FUNCTION INIT5 (I : INTEGER) RETURN PACC IS
 125                     ACCV : PACC := NEW VECTOR'(1 .. F (I) => F (I));
 126                BEGIN
 127                     RETURN ACCV;
 128                END INIT5;
 129
 130                PROCEDURE CHECK1 (B : PBOOL; I : INTEGER; S : STRING) IS
 131                BEGIN
 132                     IF B /= PBOOL'VAL (I) THEN
 133                          FAILED ( S & " HAS AN INCORRECT VALUE OF " &
 134                                   PBOOL'IMAGE (B));
 135                     END IF;
 136                END CHECK1;
 137
 138                PROCEDURE CHECK2 (I : PINT; J : INTEGER; S : STRING) IS
 139                BEGIN
 140                     IF I /= PINT'VAL (J) THEN
 141                          FAILED ( S & " HAS AN INCORRECT VALUE OF " &
 142                                   PINT'IMAGE (I));
 143                     END IF;
 144                END CHECK2;
 145
 146                PROCEDURE CHECK3 (R : PREC; I, J : INTEGER;
 147                                  S : STRING) IS
 148                BEGIN
 149                     IF R.D /= I THEN
 150                          FAILED ( S & ".D HAS AN INCORRECT VALUE OF "
 151                                   & INTEGER'IMAGE (R.D));
 152                     END IF;
 153
 154                     IF R.VALUE /= J THEN
 155                          FAILED ( S & ".VALUE HAS AN INCORRECT " &
 156                                   "VALUE OF " &
 157                                   INTEGER'IMAGE (R.VALUE));
 158                     END IF;
 159                END CHECK3;
 160
 161                PROCEDURE CHECK4 (A : PARR; I, J : INTEGER;
 162                                  S : STRING) IS
 163                BEGIN
 164                     IF A /= (I, J) AND A /= (J, I) THEN
 165                          FAILED ( S & " HAS AN INCORRECT VALUE" );
 166                     END IF;
 167                END CHECK4;
 168
 169                PROCEDURE CHECK5 (V : PACC; S : STRING) IS
 170                BEGIN
 171                     IF V'LAST /= 1 THEN
 172                          FAILED ( S & " HAS AN INCORRECT UPPER BOUND "
 173                                   & "OF " & INTEGER'IMAGE (V'LAST));
 174                     END IF;
 175
 176                     IF V (1) /= 2 THEN
 177                          FAILED ( S & " HAS AN INCORRECT COMPONENT " &
 178                                   "VALUE" );
 179                     END IF;
 180                END CHECK5;
 181
 182                PROCEDURE CHECK6 (V : PACC; S : STRING) IS
 183                BEGIN
 184                     IF V'LAST /= 3 THEN
 185                          FAILED ( S & " HAS AN INCORRECT UPPER BOUND "
 186                                   & "OF " & INTEGER'IMAGE (V'LAST));
 187                     END IF;
 188
 189                     IF V.ALL = (4, 5, 6) OR V.ALL = (5, 4, 6) OR
 190                        V.ALL = (4, 6, 5) OR V.ALL = (6, 4, 5) OR
 191                        V.ALL = (5, 6, 4) OR V.ALL = (6, 5, 4) THEN
 192                          NULL;
 193                     ELSE
 194                          FAILED ( S & " HAS AN INCORRECT COMPONENT " &
 195                                   "VALUE" );
 196                     END IF;
 197                END CHECK6;
 198
 199           END PKG1;
 200
 201           PACKAGE PKG2 IS END PKG2;
 202
 203           PACKAGE BODY PKG2 IS
 204                USE PKG1;
 205
 206                B1, B2   : PBOOL := INIT1 (1);
 207                CB1, CB2 : CONSTANT PBOOL := INIT1 (2);
 208
 209                I1, I2   : PINT := INIT2 (3);
 210                CI1, CI2 : CONSTANT PINT := INIT2 (4);
 211
 212                R1, R2   : PREC (G (5)) := INIT3 (5);
 213                CR1, CR2 : CONSTANT PREC (G (6)) := INIT3 (6);
 214
 215                A1, A2   : PARR := INIT4 (7);
 216                CA1, CA2 : CONSTANT PARR := INIT4 (8);
 217
 218                V1, V2   : PACC  := INIT5 (9);
 219                CV1, CV2 : CONSTANT PACC  := INIT5 (10);
 220
 221           BEGIN
 222                CHECK1 (B1, 0, "B1");
 223                CHECK1 (B2, 1, "B2");
 224                CHECK1 (CB1, 0, "CB1");
 225                CHECK1 (CB2, 1, "CB2");
 226
 227                CHECK2 (I1, 1, "I1");
 228                CHECK2 (I2, 2, "I2");
 229                CHECK2 (CI1, 1, "CI1");
 230                CHECK2 (CI2, 2, "CI2");
 231
 232                CHECK3 (R1, 1, 2, "R1");
 233                CHECK3 (R2, 3, 4, "R2");
 234                CHECK3 (CR1, 1, 2, "CR1");
 235                CHECK3 (CR2, 3, 4, "CR2");
 236
 237                CHECK4 (A1, 1, 2, "A1");
 238                CHECK4 (A2, 3, 4, "A2");
 239                CHECK4 (CA1, 1, 2, "CA1");
 240                CHECK4 (CA2, 3, 4, "CA2");
 241
 242                CHECK5 (V1, "V1");
 243                CHECK6 (V2, "V2");
 244                CHECK5 (CV1, "CV1");
 245                CHECK6 (CV2, "CV2");
 246       END PKG2;
 247
 248      BEGIN
 249           NULL;
 250      END;
 251
 252      RESULT;
 253 END C32001E;