old-autovect-branch/gcc/testsuite/ada/acats/tests/c4/c44003g.ada

   1 -- C44003G.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 FOR CORRECT PRECEDENCE OF PRE-DEFINED AND OVERLOADED
  27 --     OPERATIONS ON BOOLEAN TYPES AND ONE-DIMENSIONAL ARRAYS WITH
  28 --     COMPONENTS OF TYPE BOOLEAN.
  29
  30 -- HISTORY:
  31 --     RJW 10/13/88  CREATED ORIGINAL TEST.
  32
  33 WITH REPORT; USE REPORT;
  34 PROCEDURE C44003G IS
  35
  36 BEGIN
  37      TEST ("C44003G", "CHECK FOR CORRECT PRECEDENCE OF PRE-DEFINED " &
  38                       "AND OVERLOADED OPERATIONS ON BOOLEAN TYPES " &
  39                       "AND ONE-DIMENSIONAL ARRAYS WITH COMPONENTS OF " &
  40                       "TYPE BOOLEAN");
  41
  42 ----- PREDEFINED BOOLEAN:
  43
  44      DECLARE
  45           T : BOOLEAN := TRUE;
  46           F : BOOLEAN := FALSE;
  47
  48           FUNCTION "AND" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
  49           BEGIN
  50                RETURN FALSE;
  51           END "AND";
  52
  53           FUNCTION "<" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
  54           BEGIN
  55                RETURN TRUE;
  56           END "<";
  57
  58           FUNCTION "-" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
  59           BEGIN
  60                RETURN TRUE;
  61           END "-";
  62
  63           FUNCTION "+" (RIGHT : BOOLEAN) RETURN BOOLEAN IS
  64           BEGIN
  65                RETURN NOT RIGHT;
  66           END "+";
  67
  68           FUNCTION "*" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
  69           BEGIN
  70                RETURN FALSE;
  71           END "*";
  72
  73           FUNCTION "**" (LEFT, RIGHT : BOOLEAN) RETURN BOOLEAN IS
  74           BEGIN
  75                RETURN TRUE;
  76           END "**";
  77
  78      BEGIN
  79           IF NOT (+T = F) OR T /= +F OR (TRUE AND FALSE ** TRUE) OR
  80              NOT (+T < F) OR NOT (T - F * T) OR (NOT T - F XOR + F - F)
  81              THEN
  82                FAILED ("INCORRECT RESULT - 1");
  83           END IF;
  84
  85      END;
  86
  87 ----- ARRAYS:
  88
  89      DECLARE
  90           TYPE ARR IS ARRAY (INTEGER RANGE <>) OF BOOLEAN;
  91
  92           SUBTYPE SARR IS ARR (1 .. 3);
  93
  94           T : SARR := (OTHERS => TRUE);
  95           F : SARR := (OTHERS => FALSE);
  96
  97           FUNCTION "XOR" (LEFT, RIGHT : ARR) RETURN ARR IS
  98           BEGIN
  99                RETURN (1 .. 3 => FALSE);
 100           END "XOR";
 101
 102           FUNCTION "<=" (LEFT, RIGHT : ARR) RETURN ARR IS
 103           BEGIN
 104                RETURN (1 .. 3 => TRUE);
 105           END "<=";
 106
 107           FUNCTION "+" (LEFT, RIGHT : ARR) RETURN ARR IS
 108           BEGIN
 109                RETURN (1 .. 3 => FALSE);
 110           END "+";
 111
 112           FUNCTION "MOD" (LEFT, RIGHT : ARR) RETURN ARR IS
 113           BEGIN
 114                RETURN (1 .. 3 => TRUE);
 115           END "MOD";
 116
 117           FUNCTION "**" (LEFT, RIGHT : ARR) RETURN ARR IS
 118           BEGIN
 119                RETURN (1 .. 3 => FALSE);
 120           END "**";
 121      BEGIN
 122           IF (F ** T <= F + T MOD T XOR T) /= (1 .. 3 => FALSE)
 123              THEN
 124                FAILED ("INCORRECT RESULT - 2");
 125           END IF;
 126
 127           IF F ** T & T /= NOT T & T OR
 128              (T MOD F <= T) /= (1 .. 3 => TRUE) THEN
 129                FAILED ("INCORRECT RESULT - 3");
 130           END IF;
 131      END;
 132
 133      RESULT;
 134 END C44003G;