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

   1 -- C36205L.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 --      FOR GENERIC PROCEDURES, CHECK THAT ATTRIBUTES GIVE THE
  27 --      CORRECT VALUES FOR UNCONSTRAINED FORMAL PARAMETERS.
  28 --      BASIC CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS PASSED AS
  29 --      PARAMETERS TO GENERIC PROCEDURES
  30
  31 -- HISTORY
  32 --      EDWARD V. BERARD, 9 AUGUST 1990
  33 --      DAS   8 OCT 1990   ADDED OUT MODE PARAMETER TO GENERIC
  34 --                         PROCEDURE TEST_PROCEDURE AND FORMAL
  35 --                         GENERIC PARAMETER COMPONENT_VALUE.
  36
  37 WITH REPORT ;
  38
  39 PROCEDURE C36205L IS
  40
  41      SHORT_START : CONSTANT := -100 ;
  42      SHORT_END   : CONSTANT := 100 ;
  43      TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
  44      SHORT_LENGTH : CONSTANT NATURAL := (SHORT_END - SHORT_START + 1) ;
  45
  46      MEDIUM_START    : CONSTANT := 1 ;
  47      MEDIUM_END      : CONSTANT := 100 ;
  48      TYPE MEDIUM_RANGE IS RANGE MEDIUM_START .. MEDIUM_END ;
  49      MEDIUM_LENGTH : CONSTANT NATURAL := (MEDIUM_END - MEDIUM_START
  50                                           + 1) ;
  51
  52      TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
  53                          SEP, OCT, NOV, DEC) ;
  54      TYPE DAY_TYPE IS RANGE 1 .. 31 ;
  55      TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
  56      TYPE DATE IS RECORD
  57           MONTH : MONTH_TYPE ;
  58           DAY   : DAY_TYPE ;
  59           YEAR  : YEAR_TYPE ;
  60      END RECORD ;
  61
  62      TODAY : DATE := (MONTH => AUG,
  63                       DAY   => 9,
  64                       YEAR  => 1990) ;
  65
  66      SUBTYPE SHORT_STRING IS STRING (1 ..5) ;
  67
  68      DEFAULT_STRING : SHORT_STRING := "ABCDE" ;
  69
  70      TYPE FIRST_TEMPLATE IS ARRAY (SHORT_RANGE RANGE <>,
  71                                    MEDIUM_RANGE RANGE <>) OF DATE ;
  72
  73      TYPE SECOND_TEMPLATE IS ARRAY (MONTH_TYPE RANGE <>,
  74                                     DAY_TYPE RANGE <>) OF SHORT_STRING ;
  75
  76      TYPE THIRD_TEMPLATE IS ARRAY (CHARACTER RANGE <>,
  77                                    BOOLEAN RANGE <>) OF DAY_TYPE ;
  78
  79      FIRST_ARRAY      : FIRST_TEMPLATE (-10 .. 10, 27 .. 35)
  80                             := (-10 .. 10 =>
  81                                (27 .. 35 => TODAY)) ;
  82      SECOND_ARRAY     : SECOND_TEMPLATE (JAN .. JUN, 1 .. 25)
  83                             := (JAN .. JUN =>
  84                                (1 .. 25 => DEFAULT_STRING)) ;
  85      THIRD_ARRAY      : THIRD_TEMPLATE ('A' .. 'Z', FALSE .. TRUE)
  86                             := ('A' .. 'Z' =>
  87                                (FALSE .. TRUE => DAY_TYPE (9))) ;
  88
  89      FOURTH_ARRAY    : FIRST_TEMPLATE (0 .. 27, 75 .. 100)
  90                             := (0 .. 27 =>
  91                                (75 .. 100 => TODAY)) ;
  92      FIFTH_ARRAY     : SECOND_TEMPLATE (JUL .. OCT, 6 .. 10)
  93                             := (JUL .. OCT =>
  94                                (6 .. 10 => DEFAULT_STRING)) ;
  95      SIXTH_ARRAY      : THIRD_TEMPLATE ('X' .. 'Z', TRUE .. TRUE)
  96                             := ('X' .. 'Z' =>
  97                                (TRUE .. TRUE => DAY_TYPE (31))) ;
  98
  99      GENERIC
 100
 101           TYPE FIRST_INDEX IS (<>) ;
 102           TYPE SECOND_INDEX IS (<>) ;
 103           TYPE COMPONENT_TYPE IS PRIVATE ;
 104           TYPE UNCONSTRAINED_ARRAY IS ARRAY (FIRST_INDEX RANGE <>,
 105                     SECOND_INDEX RANGE <>) OF COMPONENT_TYPE ;
 106           COMPONENT_VALUE: IN  COMPONENT_TYPE;
 107
 108      PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
 109                                FFIFS        : IN FIRST_INDEX ;
 110                                FFILS        : IN FIRST_INDEX ;
 111                                FSIFS        : IN SECOND_INDEX ;
 112                                FSILS        : IN SECOND_INDEX ;
 113                                FFLEN        : IN NATURAL ;
 114                                FSLEN        : IN NATURAL ;
 115                                FFIRT        : IN FIRST_INDEX ;
 116                                FSIRT        : IN SECOND_INDEX ;
 117                                SECOND       : OUT UNCONSTRAINED_ARRAY ;
 118                                SFIFS        : IN FIRST_INDEX ;
 119                                SFILS        : IN FIRST_INDEX ;
 120                                SSIFS        : IN SECOND_INDEX ;
 121                                SSILS        : IN SECOND_INDEX ;
 122                                SFLEN        : IN NATURAL ;
 123                                SSLEN        : IN NATURAL ;
 124                                SFIRT        : IN FIRST_INDEX ;
 125                                SSIRT        : IN SECOND_INDEX ;
 126                                REMARKS      : IN STRING) ;
 127
 128      PROCEDURE TEST_PROCEDURE (FIRST        : IN UNCONSTRAINED_ARRAY ;
 129                                FFIFS        : IN FIRST_INDEX ;
 130                                FFILS        : IN FIRST_INDEX ;
 131                                FSIFS        : IN SECOND_INDEX ;
 132                                FSILS        : IN SECOND_INDEX ;
 133                                FFLEN        : IN NATURAL ;
 134                                FSLEN        : IN NATURAL ;
 135                                FFIRT        : IN FIRST_INDEX ;
 136                                FSIRT        : IN SECOND_INDEX ;
 137                                SECOND       : OUT UNCONSTRAINED_ARRAY ;
 138                                SFIFS        : IN FIRST_INDEX ;
 139                                SFILS        : IN FIRST_INDEX ;
 140                                SSIFS        : IN SECOND_INDEX ;
 141                                SSILS        : IN SECOND_INDEX ;
 142                                SFLEN        : IN NATURAL ;
 143                                SSLEN        : IN NATURAL ;
 144                                SFIRT        : IN FIRST_INDEX ;
 145                                SSIRT        : IN SECOND_INDEX ;
 146                                REMARKS      : IN STRING) IS
 147
 148      BEGIN -- TEST_PROCEDURE
 149
 150           IF (FIRST'FIRST /= FFIFS) OR
 151              (FIRST'FIRST (1) /= FFIFS) OR
 152              (FIRST'FIRST (2) /= FSIFS) OR
 153              (SECOND'FIRST /= SFIFS) OR
 154              (SECOND'FIRST (1) /= SFIFS) OR
 155              (SECOND'FIRST (2) /= SSIFS) THEN
 156                REPORT.FAILED ("PROBLEMS WITH 'FIRST. " & REMARKS) ;
 157           END IF ;
 158
 159           IF (FIRST'LAST /= FFILS) OR
 160              (FIRST'LAST (1) /= FFILS) OR
 161              (FIRST'LAST (2) /= FSILS) OR
 162              (SECOND'LAST /= SFILS) OR
 163              (SECOND'LAST (1) /= SFILS) OR
 164              (SECOND'LAST (2) /= SSILS) THEN
 165                REPORT.FAILED ("PROBLEMS WITH 'LAST. " & REMARKS) ;
 166           END IF ;
 167
 168           IF (FIRST'LENGTH /= FFLEN) OR
 169              (FIRST'LENGTH (1) /= FFLEN) OR
 170              (FIRST'LENGTH (2) /= FSLEN) OR
 171              (SECOND'LENGTH /= SFLEN) OR
 172              (SECOND'LENGTH (1) /= SFLEN) OR
 173              (SECOND'LENGTH (2) /= SSLEN) THEN
 174                REPORT.FAILED ("PROBLEMS WITH 'LENGTH. " & REMARKS) ;
 175           END IF ;
 176
 177           IF (FFIRT NOT IN FIRST'RANGE (1)) OR
 178              (FFIRT NOT IN FIRST'RANGE) OR
 179              (SFIRT NOT IN SECOND'RANGE (1)) OR
 180              (SFIRT NOT IN SECOND'RANGE) OR
 181              (FSIRT NOT IN FIRST'RANGE (2)) OR
 182              (SSIRT NOT IN SECOND'RANGE (2)) THEN
 183                REPORT.FAILED ("INCORRECT HANDLING OF 'RANGE " &
 184                               "ATTRIBUTE.  " & REMARKS) ;
 185           END IF ;
 186
 187           -- ASSIGN VALUES TO THE ARRAY PARAMETER OF MODE OUT
 188           FOR I IN SECOND'RANGE(1) LOOP
 189                FOR J IN SECOND'RANGE(2) LOOP
 190                     SECOND(I, J) := COMPONENT_VALUE;
 191                END LOOP;
 192           END LOOP;
 193
 194      END TEST_PROCEDURE ;
 195
 196      PROCEDURE FIRST_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
 197           FIRST_INDEX           => SHORT_RANGE,
 198           SECOND_INDEX          => MEDIUM_RANGE,
 199           COMPONENT_TYPE        => DATE,
 200           UNCONSTRAINED_ARRAY   => FIRST_TEMPLATE,
 201           COMPONENT_VALUE       => TODAY) ;
 202
 203      PROCEDURE SECOND_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
 204           FIRST_INDEX           => MONTH_TYPE,
 205           SECOND_INDEX          => DAY_TYPE,
 206           COMPONENT_TYPE        => SHORT_STRING,
 207           UNCONSTRAINED_ARRAY   => SECOND_TEMPLATE,
 208           COMPONENT_VALUE       => DEFAULT_STRING) ;
 209
 210      PROCEDURE THIRD_TEST_PROCEDURE IS NEW TEST_PROCEDURE (
 211           FIRST_INDEX           => CHARACTER,
 212           SECOND_INDEX          => BOOLEAN,
 213           COMPONENT_TYPE        => DAY_TYPE,
 214           UNCONSTRAINED_ARRAY   => THIRD_TEMPLATE,
 215           COMPONENT_VALUE       => DAY_TYPE'FIRST) ;
 216
 217
 218 BEGIN  -- C36205L
 219
 220       REPORT.TEST ( "C36205L","FOR GENERIC PROCEDURES, CHECK THAT " &
 221                     "ATTRIBUTES GIVE THE CORRECT VALUES FOR " &
 222                     "UNCONSTRAINED FORMAL PARAMETERS.  BASIC " &
 223                     "CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS " &
 224                     "PASSED AS PARAMETERS TO GENERIC PROCEDURES");
 225
 226      FIRST_TEST_PROCEDURE (FIRST        => FIRST_ARRAY,
 227                            FFIFS        => -10,
 228                            FFILS        => 10,
 229                            FSIFS        => 27,
 230                            FSILS        => 35,
 231                            FFLEN        => 21,
 232                            FSLEN        => 9,
 233                            FFIRT        => 0,
 234                            FSIRT        => 29,
 235                            SECOND       => FOURTH_ARRAY,
 236                            SFIFS        => 0,
 237                            SFILS        => 27,
 238                            SSIFS        => 75,
 239                            SSILS        => 100,
 240                            SFLEN        => 28,
 241                            SSLEN        => 26,
 242                            SFIRT        => 5,
 243                            SSIRT        => 100,
 244                            REMARKS      => "FIRST_TEST_PROCEDURE") ;
 245
 246      SECOND_TEST_PROCEDURE (FIRST        => SECOND_ARRAY,
 247                             FFIFS        => JAN,
 248                             FFILS        => JUN,
 249                             FSIFS        => 1,
 250                             FSILS        => 25,
 251                             FFLEN        => 6,
 252                             FSLEN        => 25,
 253                             FFIRT        => MAR,
 254                             FSIRT        => 17,
 255                             SECOND       => FIFTH_ARRAY,
 256                             SFIFS        => JUL,
 257                             SFILS        => OCT,
 258                             SSIFS        => 6,
 259                             SSILS        => 10,
 260                             SFLEN        => 4,
 261                             SSLEN        => 5,
 262                             SFIRT        => JUL,
 263                             SSIRT        => 6,
 264                             REMARKS      => "SECOND_TEST_PROCEDURE") ;
 265
 266      THIRD_TEST_PROCEDURE (FIRST        => THIRD_ARRAY,
 267                            FFIFS        => 'A',
 268                            FFILS        => 'Z',
 269                            FSIFS        => FALSE,
 270                            FSILS        => TRUE,
 271                            FFLEN        => 26,
 272                            FSLEN        => 2,
 273                            FFIRT        => 'T',
 274                            FSIRT        => TRUE,
 275                            SECOND       => SIXTH_ARRAY,
 276                            SFIFS        => 'X',
 277                            SFILS        => 'Z',
 278                            SSIFS        => TRUE,
 279                            SSILS        => TRUE,
 280                            SFLEN        => 3,
 281                            SSLEN        => 1,
 282                            SFIRT        => 'Z',
 283                            SSIRT        => TRUE,
 284                            REMARKS      => "THIRD_TEST_PROCEDURE") ;
 285
 286       REPORT.RESULT ;
 287
 288 END C36205L ;