gcc/testsuite/ada/acats/tests/cc/cc3017c.ada

   1 -- CC3017C.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 AN INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
  27 --     PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
  28 --     DECLARE A FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS
  29 --     ARE COPIED.
  30 --
  31 --     SUBTESTS ARE:
  32 --         (A) SCALAR PARAMETERS TO PROCEDURES.
  33 --         (B) SCALAR PARAMETERS TO FUNCTIONS.
  34 --         (C) ACCESS PARAMETERS TO PROCEDURES.
  35 --         (D) ACCESS PARAMETERS TO FUNCTIONS.
  36
  37 -- HISTORY:
  38 --     EDWARD V. BERARD, 7 AUGUST 1990
  39 --     CJJ 10/16/90  ADJUSTED LINES THAT WERE TOO LONG; REFORMATTED
  40 --                   HEADER TO CONFORM TO ACVC STANDARDS.
  41 --
  42
  43 WITH REPORT;
  44 PROCEDURE CC3017C IS
  45
  46 BEGIN
  47      REPORT.TEST ("CC3017C", "CHECK THAT AN INSTANCE OF A GENERIC " &
  48                   "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
  49                   "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
  50                   "FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS " &
  51                   "ARE COPIED");
  52
  53      --------------------------------------------------
  54
  55      SCALAR_TO_PROCS:
  56
  57      DECLARE
  58
  59 --        (A) SCALAR PARAMETERS TO PROCEDURES.
  60
  61           TYPE NUMBER IS RANGE 0 .. 120 ;
  62           VALUE : NUMBER ;
  63           E     : EXCEPTION ;
  64
  65           GENERIC
  66
  67             TYPE SCALAR_ITEM IS RANGE <> ;
  68
  69           PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
  70                        P_OUT     : OUT SCALAR_ITEM ;
  71                        P_IN_OUT : IN OUT SCALAR_ITEM) ;
  72
  73           PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
  74                        P_OUT     : OUT SCALAR_ITEM ;
  75                        P_IN_OUT : IN OUT SCALAR_ITEM) IS
  76
  77                STORE  : SCALAR_ITEM ;
  78
  79           BEGIN  -- P
  80
  81                STORE := P_IN;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
  82
  83                P_OUT := 10;
  84                IF (P_IN /= STORE) THEN
  85                     REPORT.FAILED ("ASSIGNMENT TO SCALAR OUT " &
  86                                    "PARAMETER CHANGES THE VALUE OF " &
  87                                    "INPUT PARAMETER");
  88                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
  89                END IF;
  90
  91                P_IN_OUT := P_IN_OUT + 100;
  92                IF (P_IN /= STORE) THEN
  93                     REPORT.FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
  94                                    "PARAMETER CHANGES THE VALUE OF " &
  95                                    "INPUT PARAMETER");
  96                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
  97                END IF;
  98
  99                VALUE := VALUE + 1;
 100                IF (P_IN /= STORE) THEN
 101                     REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL " &
 102                                    "PARAMETER CHANGES THE VALUE OF " &
 103                                    "INPUT PARAMETER");
 104                END IF;
 105
 106                RAISE E;  -- CHECK EXCEPTION HANDLING.
 107           END P;
 108
 109           PROCEDURE NEW_P IS NEW P (SCALAR_ITEM => NUMBER) ;
 110
 111      BEGIN  -- SCALAR_TO_PROCS
 112           VALUE := 0;   -- INITIALIZE VALUE SO VARIOUS CASES CAN BE DETECTED.
 113
 114           NEW_P (P_IN     => VALUE,
 115                  P_OUT    => VALUE,
 116                  P_IN_OUT => VALUE);
 117
 118           REPORT.FAILED ("EXCEPTION NOT RAISED - SCALARS TO PROCEDURES");
 119      EXCEPTION
 120           WHEN E =>
 121                IF (VALUE /= 1) THEN
 122                     CASE VALUE IS
 123                          WHEN 11  =>
 124                               REPORT.FAILED ("OUT ACTUAL SCALAR " &
 125                                              "PARAMETER CHANGED GLOBAL VALUE");
 126                          WHEN 101 =>
 127                               REPORT.FAILED ("IN OUT ACTUAL SCALAR " &
 128                                              "PARAMETER CHANGED GLOBAL VALUE");
 129                          WHEN 111 =>
 130                               REPORT.FAILED ("OUT AND IN OUT ACTUAL " &
 131                                              "SCALAR PARAMETERS CHANGED " &
 132                                              "GLOBAL VALUE");
 133                          WHEN OTHERS =>
 134                               REPORT.FAILED ("UNDETERMINED CHANGE TO " &
 135                                              "GLOBAL VALUE");
 136                     END CASE;
 137                END IF;
 138           WHEN OTHERS =>
 139               REPORT.FAILED ("WRONG EXCEPTION RAISED - SCALARS TO PROCEDURES");
 140      END SCALAR_TO_PROCS ;
 141
 142      --------------------------------------------------
 143
 144      SCALAR_TO_FUNCS:
 145
 146      DECLARE
 147
 148 --        (B) SCALAR PARAMETERS TO FUNCTIONS.
 149
 150           TYPE NUMBER IS RANGE 0 .. 101 ;
 151           FIRST  : NUMBER ;
 152           SECOND : NUMBER ;
 153
 154           GENERIC
 155
 156               TYPE ITEM IS RANGE <> ;
 157
 158           FUNCTION F (F_IN : IN ITEM) RETURN ITEM ;
 159
 160           FUNCTION F (F_IN : IN ITEM) RETURN ITEM IS
 161
 162                STORE  : ITEM := F_IN;
 163
 164           BEGIN  -- F
 165
 166                FIRST := FIRST + 1;
 167                IF (F_IN /= STORE) THEN
 168                     REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL FUNCTION " &
 169                                    "PARAMETER CHANGES THE VALUE OF " &
 170                                    "INPUT PARAMETER");
 171                END IF;
 172
 173                RETURN (100);
 174           END F;
 175
 176           FUNCTION NEW_F IS NEW F (ITEM => NUMBER) ;
 177
 178      BEGIN  -- SCALAR_TO_FUNCS
 179           FIRST  := 100 ;
 180           SECOND := NEW_F (FIRST) ;
 181      END SCALAR_TO_FUNCS ;
 182
 183      --------------------------------------------------
 184
 185      ACCESS_TO_PROCS:
 186
 187      DECLARE
 188
 189 --        (C) ACCESS PARAMETERS TO PROCEDURES.
 190
 191           TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
 192                                SEP, OCT, NOV, DEC) ;
 193           TYPE DAY_TYPE IS RANGE 1 .. 31 ;
 194           TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
 195           TYPE DATE IS RECORD
 196               MONTH : MONTH_TYPE ;
 197               DAY   : DAY_TYPE ;
 198               YEAR  : YEAR_TYPE ;
 199           END RECORD ;
 200
 201           TYPE DATE_ACCESS IS ACCESS DATE ;
 202           DATE_POINTER : DATE_ACCESS ;
 203
 204           E    : EXCEPTION;
 205
 206           GENERIC
 207
 208             TYPE ITEM IS PRIVATE ;
 209             TYPE ACCESS_ITEM IS ACCESS ITEM ;
 210
 211           PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;
 212                        P_OUT    : OUT    ACCESS_ITEM ;
 213                        P_IN_OUT : IN OUT ACCESS_ITEM) ;
 214
 215           PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;
 216                        P_OUT    : OUT    ACCESS_ITEM ;
 217                        P_IN_OUT : IN OUT ACCESS_ITEM) IS
 218
 219                STORE  : ACCESS_ITEM ;
 220
 221           BEGIN  -- P
 222
 223                STORE := P_IN ;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
 224
 225                DATE_POINTER := NEW DATE'(YEAR  => 1990,
 226                                          DAY   => 7,
 227                                          MONTH => AUG) ;
 228                IF (P_IN /= STORE) THEN
 229                     REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL " &
 230                                    "PARAMETER CHANGES THE VALUE OF " &
 231                                    "INPUT PARAMETER");
 232                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
 233                END IF;
 234
 235                P_OUT := NEW ITEM ;
 236                IF (P_IN /= STORE) THEN
 237                     REPORT.FAILED ("ASSIGNMENT TO ACCESS OUT " &
 238                                    "PARAMETER CHANGES THE VALUE OF " &
 239                                    "INPUT PARAMETER");
 240                     STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
 241                END IF;
 242
 243                P_IN_OUT :=  NEW ITEM ;
 244                IF (P_IN /= STORE) THEN
 245                     REPORT.FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
 246                                    "PARAMETER CHANGES THE VALUE OF " &
 247                                    "INPUT PARAMETER");
 248                END IF;
 249
 250                RAISE E;  -- CHECK EXCEPTION HANDLING.
 251           END P ;
 252
 253           PROCEDURE NEW_P IS NEW P (ITEM         => DATE,
 254                                     ACCESS_ITEM  => DATE_ACCESS) ;
 255
 256      BEGIN  -- ACCESS_TO_PROCS
 257           DATE_POINTER := NEW DATE'(MONTH => DEC,
 258                                     DAY   => 25,
 259                                     YEAR  => 2000) ;
 260
 261           NEW_P (P_IN       => DATE_POINTER,
 262                    P_OUT    => DATE_POINTER,
 263                    P_IN_OUT => DATE_POINTER) ;
 264
 265           REPORT.FAILED ("EXCEPTION NOT RAISED - ACCESS TO PROCEDURES");
 266      EXCEPTION
 267           WHEN E =>
 268                IF (DATE_POINTER.ALL /= (AUG, 7, 1990)) THEN
 269                     REPORT.FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
 270                                    "PARAMETER VALUE CHANGED DESPITE " &
 271                                    "RAISED EXCEPTION");
 272                END IF;
 273           WHEN OTHERS =>
 274                REPORT.FAILED ("WRONG EXCEPTION RAISED - ACCESS TO PROCEDURES");
 275      END ACCESS_TO_PROCS ;
 276
 277      --------------------------------------------------
 278
 279      ACCESS_TO_FUNCS:
 280
 281      DECLARE
 282
 283 --        (D) ACCESS PARAMETERS TO FUNCTIONS.
 284
 285           TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
 286                                SEP, OCT, NOV, DEC) ;
 287           TYPE DAY_TYPE IS RANGE 1 .. 31 ;
 288           TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
 289           TYPE DATE IS RECORD
 290             MONTH : MONTH_TYPE ;
 291             DAY   : DAY_TYPE ;
 292             YEAR  : YEAR_TYPE ;
 293           END RECORD ;
 294
 295           TYPE DATE_ACCESS IS ACCESS DATE ;
 296           DATE_POINTER : DATE_ACCESS ;
 297           NEXT_DATE    : DATE_ACCESS ;
 298
 299           GENERIC
 300
 301             TYPE ITEM IS PRIVATE ;
 302             TYPE ACCESS_ITEM IS ACCESS ITEM ;
 303
 304           FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM ;
 305
 306           FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM IS
 307
 308                STORE  : ACCESS_ITEM := F_IN ;
 309
 310           BEGIN  -- F
 311
 312                DATE_POINTER := NEW DATE'(YEAR  => 1990,
 313                                             DAY   => 7,
 314                                          MONTH => AUG) ;
 315                IF (F_IN /= STORE) THEN
 316                     REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL FUNCTION " &
 317                                    "PARAMETER CHANGES THE VALUE OF " &
 318                                    "INPUT PARAMETER");
 319                END IF;
 320
 321                RETURN (NULL);
 322           END F ;
 323
 324           FUNCTION NEW_F IS NEW F (ITEM        => DATE,
 325                                    ACCESS_ITEM => DATE_ACCESS) ;
 326
 327      BEGIN  -- ACCESS_TO_FUNCS
 328           DATE_POINTER := NULL ;
 329           NEXT_DATE    := NEW_F(F_IN => DATE_POINTER) ;
 330      END ACCESS_TO_FUNCS ;
 331
 332      --------------------------------------------------
 333
 334      REPORT.RESULT;
 335
 336 END CC3017C;