gomp-20050608-branch/gcc/testsuite/ada/acats/tests/c5/c52104y.ada

   1 -- C52104Y.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 LENGTHS MUST MATCH IN ARRAY AND SLICE ASSIGNMENTS.
  26 --    MORE SPECIFICALLY, TEST THAT ATTEMPTED ASSIGNMENTS BETWEEN
  27 --    ARRAYS WITH NON-MATCHING LENGTHS LEAVE THE DESTINATION ARRAY
  28 --    INTACT AND CAUSE  CONSTRAINT_ERROR  TO BE RAISED.
  29 --    (OVERLAPS BETWEEN THE OPERANDS OF THE ASSIGNMENT STATEMENT
  30 --    ARE TREATED ELSEWHERE.)
  31
  32 -- THIS IS A SPECIAL CASE IN
  33
  34 --    DIVISION  D :  NULL ARRAYS WHOSE LENGTHS ARE NOT DETERMINABLE
  35 --                   STATICALLY
  36
  37 -- WHICH (THE SPECIAL CASE) TREATS TWO-DIMENSIONAL ARRAYS WHOSE LENGTH
  38 --    ALONG ONE DIMENSION IS GREATER THAN  INTEGER'LAST  AND WHOSE
  39 --    LENGTH ALONG THE OTHER DIMENSION IS  0 .
  40 --    AN ADDITIONAL OBJECTIVE OF THIS TEST IS TO CHECK WHETHER LENGTH
  41 --    COMPARISONS (AND LENGTH COMPUTATIONS) CAUSE  CONSTRAINT_ERROR
  42 --    TO BE RAISED.
  43
  44 -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
  45 -- ***       remove incompatibilities associated with the transition   -- 9X
  46 -- ***       to Ada 9X.                                                -- 9X
  47 -- ***                                                                 -- 9X
  48
  49 -- RM  07/31/81
  50 -- SPS 03/22/83
  51 -- JBG 06/16/83
  52 -- EG  10/28/85  FIX NUMERIC_ERROR/CONSTRAINT_ERROR ACCORDING TO
  53 --               AI-00387.
  54 -- MRM 03/30/93  REMOVE NUMERIC_ERROR FOR 9X COMPATIBILITY
  55
  56 WITH REPORT;
  57 PROCEDURE  C52104Y  IS
  58
  59      USE  REPORT ;
  60
  61 BEGIN
  62
  63      TEST( "C52104Y" , "CHECK THAT IN ARRAY ASSIGNMENTS AND IN SLICE" &
  64                        " ASSIGNMENTS, THE LENGTHS MUST MATCH" );
  65
  66      -- IN THIS TEST WE CAN'T USE AGGREGATE ASSIGNMENT (EXCEPT WHEN
  67      --    THE AGGREGATES ARE STRING LITERALS); THEREFORE:
  68      --
  69      --    (1) ARRAYS WILL BE INITIALIZED BY INDIVIDUAL ASSIGNMENTS;
  70      --    (2) CAN'T USE NON-NULL CONSTANT ARRAYS.
  71
  72
  73      -- WE ASSUME THAT IN AN ARRAY_TYPE_DEFINITION THE INDEX PORTION
  74      --    AND THE COMPONENT_TYPE PORTION ARE FUNCTIONALLY ORTHOGONAL
  75      --    ALSO AT THE IMPLEMENTATION LEVEL, I.E. THAT THE CORRECTNESS
  76      --    OF THE ACCESSING MECHANISM FOR ARRAYS DOES NOT DEPEND ON
  77      --    COMPONENT_TYPE.  ACCORDINGLY WE ARE TESTING FOR SOME BUT
  78      --    NOT ALL KINDS OF COMPONENT_TYPE.  (COMPONENT_TYPES INCLUDED:
  79      --    INTEGER , CHARACTER , BOOLEAN .)
  80
  81
  82      -------------------------------------------------------------------
  83
  84      --   (10) MULTIDIMENSIONAL ARRAY OBJECTS WHOSE TYPEMARKS WERE
  85      --        DEFINED USING THE "BOX" COMPOUND SYMBOL.
  86      --        (TWO-DIMENSIONAL ARRAYS OF BOOLEANS.)
  87
  88 CONSTR_ERR:
  89      BEGIN          -- THIS BLOCK CATCHES CONSTRAINT_ERROR IF IT IS
  90                     -- RAISED BY THE SUBTYPE DECLARATION.
  91
  92 DCL_ARR:  DECLARE
  93
  94                TYPE  TABOX5  IS  ARRAY( INTEGER RANGE <> ,
  95                                         INTEGER RANGE <> )  OF BOOLEAN ;
  96                PRAGMA PACK (TABOX5);
  97
  98                SUBTYPE  TABOX52  IS  TABOX5(
  99                          IDENT_INT(13)..IDENT_INT(       13       ) ,
 100                          IDENT_INT(-6)..IDENT_INT( INTEGER'LAST-4 ) );
 101
 102           BEGIN
 103
 104                COMMENT ("NO CONSTRAINT_ERROR FOR NON-NULL ARRAY SUBTYPE " &
 105                         "WHEN ONE DIMENSION HAS INTEGER'LAST + 3 " &
 106                         "COMPONENTS");
 107
 108 OBJ_DCL:       DECLARE   -- THIS BLOCK DECLARES ONE NULL ARRAY AND ONE
 109                          -- PACKED BOOLEAN ARRAY WITH INTEGER'LAST + 3
 110                          -- COMPONENTS;  STORAGE ERROR MAY BE RAISED.
 111
 112                     ARRX51  :  TABOX5(
 113                          IDENT_INT(13)..IDENT_INT(       12       ) ,
 114                          IDENT_INT(-6)..IDENT_INT( INTEGER'LAST-4 ) );
 115                     ARRX52  :  TABOX52 ;     -- BIG ARRAY HERE.
 116
 117                BEGIN
 118
 119                     COMMENT ("NO CONSTRAINT OR STORAGE ERROR WHEN ARRAY "&
 120                             "WITH INTEGER'LAST+3 COMPONENTS ALLOCATED");
 121
 122                -- NULL ARRAY ASSIGNMENT:
 123
 124                     ARRX52 := ARRX51 ;
 125                     FAILED( "EXCEPTION NOT RAISED  (10)" );
 126
 127                EXCEPTION
 128
 129                     WHEN CONSTRAINT_ERROR =>
 130                          COMMENT ("CONSTRAINT_ERROR RAISED WHEN " &
 131                                   "CHECKING LENGTHS FOR ARRAY HAVING " &
 132                                   "> INTEGER'LAST COMPONENTS ON ONE " &
 133                                   "DIMENSION");
 134
 135
 136                     WHEN  OTHERS  =>
 137                          FAILED( "OTHER EXCEPTION RAISED - SUBTEST 10");
 138
 139                END OBJ_DCL;
 140
 141           EXCEPTION
 142
 143                WHEN STORAGE_ERROR =>
 144                     COMMENT ("STORAGE_ERROR RAISED WHEN DECLARING ONE "&
 145                              "PACKED BOOLEAN ARRAY WITH INTEGER'LAST "&
 146                              "+ 3 COMPONENTS");
 147                WHEN CONSTRAINT_ERROR =>
 148                     COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING "&
 149                              "ONE PACKED BOOLEAN ARRAY WITH "&
 150                              "INTEGER'LAST + 3 COMPONENTS");
 151                WHEN OTHERS =>
 152                     FAILED ("SOME EXCEPTION RAISED - 3");
 153
 154           END DCL_ARR;
 155
 156      EXCEPTION
 157
 158
 159           WHEN CONSTRAINT_ERROR =>
 160                COMMENT ("CONSTRAINT_ERROR RAISED WHEN DECLARING AN " &
 161                         "ARRAY SUBTYPE WITH INTEGER'LAST + 3 " &
 162                         "COMPONENTS");
 163
 164           WHEN STORAGE_ERROR =>
 165                FAILED ("STORAGE_ERROR RAISED FOR TYPE DECLARATION");
 166
 167           WHEN  OTHERS  =>
 168                FAILED( "OTHER EXCEPTION RAISED - 4");
 169
 170      END CONSTR_ERR;
 171
 172      RESULT ;
 173
 174 END C52104Y;