gcc/testsuite/ada/acats/tests/c8/c87b33a.ada

   1 -- C87B33A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
  26 --
  27 -- THE SHORT CIRCUIT CONTROL FORMS "AND THEN" AND "OR ELSE" ARE
  28 -- DEFINED AS BINARY BOOLEAN OPERATORS WHICH RETURN A BOOLEAN VALUE
  29 -- OF THE SAME TYPE AS THE OPERANDS.
  30
  31 -- TRH  13 SEPT 82
  32
  33 WITH REPORT; USE REPORT;
  34
  35 PROCEDURE C87B33A IS
  36
  37      TYPE ON   IS NEW BOOLEAN RANGE TRUE  .. TRUE;
  38      TYPE OFF  IS NEW BOOLEAN RANGE FALSE .. FALSE;
  39      TYPE YES  IS NEW ON;
  40      TYPE NO   IS NEW OFF;
  41      TYPE BIT  IS NEW BOOLEAN;
  42      TYPE FLAG IS (PASS, FAIL);
  43
  44      TYPE BOOLEAN IS (FALSE, TRUE);  -- STANDARD BOOLEAN HIDDEN.
  45
  46      GENERIC
  47           TYPE T IS PRIVATE;
  48           ARG  : IN T;
  49           STAT : FLAG;
  50      FUNCTION F1 RETURN T;
  51
  52      FUNCTION F1 RETURN T IS
  53      BEGIN
  54           IF STAT = FAIL THEN
  55                FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT " &
  56                        "CONTROL FORMS 'AND THEN' AND 'OR ELSE' ");
  57           END IF;
  58           RETURN ARG;
  59      END F1;
  60
  61      FUNCTION A IS NEW F1 (BOOLEAN, TRUE,  FAIL);
  62      FUNCTION A IS NEW F1 (NO,      FALSE, PASS);
  63      FUNCTION A IS NEW F1 (ON,      TRUE,  FAIL);
  64      FUNCTION A IS NEW F1 (YES,     TRUE,  FAIL);
  65      FUNCTION B IS NEW F1 (BOOLEAN, TRUE,  FAIL);
  66      FUNCTION B IS NEW F1 (NO,      FALSE, FAIL);
  67      FUNCTION B IS NEW F1 (OFF,     FALSE, FAIL);
  68      FUNCTION B IS NEW F1 (BIT,     TRUE,  FAIL);
  69      FUNCTION C IS NEW F1 (BOOLEAN, FALSE, FAIL);
  70      FUNCTION C IS NEW F1 (YES,     TRUE,  PASS);
  71      FUNCTION C IS NEW F1 (ON,      TRUE,  FAIL);
  72      FUNCTION C IS NEW F1 (NO,      FALSE, FAIL);
  73      FUNCTION D IS NEW F1 (BOOLEAN, FALSE, FAIL);
  74      FUNCTION D IS NEW F1 (OFF,     FALSE, FAIL);
  75      FUNCTION D IS NEW F1 (YES,     TRUE,  FAIL);
  76      FUNCTION D IS NEW F1 (BIT,     TRUE,  FAIL);
  77      FUNCTION E IS NEW F1 (BOOLEAN, FALSE, FAIL);
  78      FUNCTION E IS NEW F1 (BIT,     TRUE,  PASS);
  79      FUNCTION E IS NEW F1 (YES,     TRUE,  FAIL);
  80      FUNCTION E IS NEW F1 (NO,      FALSE, FAIL);
  81      FUNCTION F IS NEW F1 (BOOLEAN, FALSE, FAIL);
  82      FUNCTION F IS NEW F1 (BIT,     TRUE,  PASS);
  83      FUNCTION F IS NEW F1 (ON,      TRUE,  FAIL);
  84      FUNCTION F IS NEW F1 (OFF,     FALSE, FAIL);
  85      FUNCTION G IS NEW F1 (BOOLEAN, TRUE,  FAIL);
  86      FUNCTION G IS NEW F1 (BIT,     FALSE, PASS);
  87      FUNCTION G IS NEW F1 (NO,      FALSE, FAIL);
  88      FUNCTION G IS NEW F1 (YES,     TRUE,  FAIL);
  89      FUNCTION H IS NEW F1 (BOOLEAN, TRUE,  FAIL);
  90      FUNCTION H IS NEW F1 (BIT,     FALSE, PASS);
  91      FUNCTION H IS NEW F1 (OFF,     FALSE, FAIL);
  92      FUNCTION H IS NEW F1 (ON,      TRUE,  FAIL);
  93
  94 BEGIN
  95      TEST ("C87B33A","OVERLOADED OPERANDS FOR SHORT CIRCUIT CONTROL " &
  96            "FORMS 'AND THEN' AND 'OR ELSE' ");
  97
  98      IF (A AND THEN B)                        THEN
  99           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - A&B");
 100      END IF;
 101
 102      IF NOT (C OR ELSE D) THEN
 103           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - C&D");
 104      END IF;
 105
 106      IF NOT (E AND THEN F AND THEN E
 107           AND THEN F AND THEN E AND THEN F)   THEN
 108           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - E&F");
 109      END IF;
 110
 111      IF (G OR ELSE H OR ELSE G
 112           OR ELSE H OR ELSE G OR ELSE H)      THEN
 113           FAILED ("RESOLUTION INCORRECT FOR SHORT CIRCUIT FORMS - G&H");
 114      END IF;
 115
 116      RESULT;
 117 END C87B33A;