old-autovect-branch/gcc/testsuite/ada/acats/tests/c9/c95092a.ada

   1 -- C95092A.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 FOR ENTRIES OF TASKS, DEFAULT VALUES OF ALL TYPES CAN
  27 --     BE GIVEN FOR A FORMAL PARAMETER.
  28
  29 -- HISTORY:
  30 --     DHH 03/22/88 CREATED ORIGINAL TEST.
  31
  32 WITH REPORT; USE REPORT;
  33 PROCEDURE C95092A IS
  34
  35      SUBTYPE INT IS INTEGER RANGE 1 ..10;
  36      TYPE FLT IS DIGITS 5;
  37      TYPE FIX IS DELTA 0.125 RANGE 0.0 .. 10.0;
  38      TYPE ENUM IS (RED, BLUE, YELLOW);
  39      SUBTYPE CHAR IS CHARACTER RANGE 'A' .. 'F';
  40      TYPE ARR IS ARRAY(1 .. 3) OF INTEGER;
  41      TYPE REC IS
  42           RECORD
  43                A : INT;
  44                B : ENUM;
  45                C : CHAR;
  46           END RECORD;
  47
  48      FUNCTION IDENT_FLT(E : FLT) RETURN FLT IS
  49      BEGIN
  50           IF EQUAL(3,3) THEN
  51                RETURN E;
  52           ELSE
  53                RETURN 0.0;
  54           END IF;
  55      END IDENT_FLT;
  56
  57      FUNCTION IDENT_FIX(E : FIX) RETURN FIX IS
  58      BEGIN
  59           IF EQUAL(3,3) THEN
  60                RETURN E;
  61           ELSE
  62                RETURN 0.0;
  63           END IF;
  64      END IDENT_FIX;
  65
  66      FUNCTION IDENT_ENUM(E : ENUM) RETURN ENUM IS
  67      BEGIN
  68           IF EQUAL(3,3) THEN
  69                RETURN E;
  70           ELSE
  71                RETURN YELLOW;
  72           END IF;
  73      END IDENT_ENUM;
  74
  75      FUNCTION IDENT_CHAR(E : CHAR) RETURN CHAR IS
  76      BEGIN
  77           IF EQUAL(3,3) THEN
  78                RETURN E;
  79           ELSE
  80                RETURN 'F';
  81           END IF;
  82      END IDENT_CHAR;
  83
  84      FUNCTION IDENT_ARR(E : ARR) RETURN ARR IS
  85           Z : ARR := (3,2,1);
  86      BEGIN
  87           IF EQUAL(3,3) THEN
  88                RETURN E;
  89           ELSE
  90                RETURN Z;
  91           END IF;
  92      END IDENT_ARR;
  93
  94      FUNCTION IDENT_REC(E : REC) RETURN REC IS
  95           Z : REC := (10, YELLOW, 'F');
  96      BEGIN
  97           IF EQUAL(3,3) THEN
  98                RETURN E;
  99           ELSE
 100                RETURN Z;
 101           END IF;
 102      END IDENT_REC;
 103
 104      TASK TEST_DEFAULTS IS
 105           ENTRY BOOL(G : BOOLEAN := TRUE);
 106           ENTRY INTEGR(X : IN INT := 5);
 107           ENTRY FLOAT(Y : IN FLT := 1.25);
 108           ENTRY FIXED(Z : IN FIX := 1.0);
 109           ENTRY ENUMERAT(A : IN ENUM := RED);
 110           ENTRY CHARACTR(B : IN CHAR := 'A');
 111           ENTRY ARRY(C : IN ARR := (1, 2, 3));
 112           ENTRY RECD(D : IN REC := (5, RED, 'A'));
 113      END TEST_DEFAULTS;
 114
 115      TASK BODY TEST_DEFAULTS IS
 116      BEGIN
 117
 118           ACCEPT BOOL(G : BOOLEAN := TRUE) DO
 119                IF G /= IDENT_BOOL(TRUE) THEN
 120                     FAILED("BOOLEAN DEFAULT FAILED");
 121                END IF;
 122           END BOOL;
 123
 124           ACCEPT INTEGR(X : IN INT := 5) DO
 125                IF X /= IDENT_INT(5) THEN
 126                     FAILED("INTEGER DEFAULT FAILED");
 127                END IF;
 128           END INTEGR;
 129
 130           ACCEPT FLOAT(Y : IN FLT := 1.25) DO
 131                IF Y /= IDENT_FLT(1.25) THEN
 132                     FAILED("FLOAT DEFAULT FAILED");
 133                END IF;
 134           END FLOAT;
 135
 136           ACCEPT FIXED(Z : IN FIX := 1.0) DO
 137                IF Z /= IDENT_FIX(1.0) THEN
 138                     FAILED("FIXED DEFAULT FAILED");
 139                END IF;
 140           END FIXED;
 141
 142           ACCEPT ENUMERAT(A : IN ENUM := RED) DO
 143                IF A /= IDENT_ENUM(RED) THEN
 144                     FAILED("ENUMERATION DEFAULT FAILED");
 145                END IF;
 146           END ENUMERAT;
 147
 148           ACCEPT CHARACTR(B : IN CHAR := 'A') DO
 149                IF B /= IDENT_CHAR('A') THEN
 150                     FAILED("CHARACTER DEFAULT FAILED");
 151                END IF;
 152           END CHARACTR;
 153
 154           ACCEPT ARRY(C : IN ARR := (1, 2, 3)) DO
 155                FOR I IN 1 ..3 LOOP
 156                     IF C(I) /= IDENT_INT(I) THEN
 157                          FAILED("ARRAY " & INTEGER'IMAGE(I) &
 158                                 "DEFAULT FAILED");
 159                     END IF;
 160                END LOOP;
 161           END ARRY;
 162
 163           ACCEPT RECD(D : IN REC := (5, RED, 'A')) DO
 164                IF D.A /= IDENT_INT(5) THEN
 165                     FAILED("RECORD INTEGER DEFAULT FAILED");
 166                END IF;
 167                IF D.B /= IDENT_ENUM(RED) THEN
 168                     FAILED("RECORD ENUMERATION DEFAULT FAILED");
 169                END IF;
 170                IF D.C /= IDENT_CHAR('A') THEN
 171                     FAILED("RECORD CHARACTER DEFAULT FAILED");
 172                END IF;
 173           END RECD;
 174
 175      END TEST_DEFAULTS;
 176
 177 BEGIN
 178
 179      TEST("C95092A", "CHECK THAT FOR ENTRIES OF TASKS, DEFAULT " &
 180                      "VALUES OF ALL TYPES CAN BE GIVEN FOR A FORMAL " &
 181                      "PARAMETER");
 182
 183           TEST_DEFAULTS.BOOL;
 184           TEST_DEFAULTS.INTEGR;
 185           TEST_DEFAULTS.FLOAT;
 186           TEST_DEFAULTS.FIXED;
 187           TEST_DEFAULTS.ENUMERAT;
 188           TEST_DEFAULTS.CHARACTR;
 189           TEST_DEFAULTS.ARRY;
 190           TEST_DEFAULTS.RECD;
 191
 192      RESULT;
 193 END C95092A;