gcc/testsuite/ada/acats/tests/c4/c45631a.ada

   1 -- C45631A.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 FOR TYPE INTEGER 'ABS A' EQUALS A IF A IS POSITIVE AND
  26 -- EQUALS -A IF A IS NEGATIVE.
  27
  28 -- RJW 2/10/86
  29
  30 WITH REPORT; USE REPORT;
  31
  32 PROCEDURE C45631A IS
  33
  34 BEGIN
  35
  36      TEST ( "C45631A", "CHECK THAT FOR TYPE INTEGER 'ABS A' " &
  37                        "EQUALS A IF A IS POSITIVE AND EQUALS -A IF " &
  38                        "A IS NEGATIVE" );
  39
  40      DECLARE
  41
  42           P : INTEGER := IDENT_INT (1);
  43           N : INTEGER := IDENT_INT (-1);
  44           Z : INTEGER := IDENT_INT (0);
  45      BEGIN
  46
  47           IF ABS P = P THEN
  48                NULL;
  49           ELSE
  50                FAILED ( "'ABS' TEST FOR P - 1" );
  51           END IF;
  52
  53           IF ABS N = -N THEN
  54                NULL;
  55           ELSE
  56                FAILED ( "'ABS' TEST FOR N - 1" );
  57           END IF;
  58
  59           IF ABS Z = Z THEN
  60                NULL;
  61           ELSE
  62                FAILED ( "'ABS TEST FOR Z - 1" );
  63           END IF;
  64
  65           IF ABS (Z) = -Z THEN
  66                NULL;
  67           ELSE
  68                FAILED ( "'ABS TEST FOR Z - 2");
  69           END IF;
  70
  71           IF "ABS" (RIGHT => P) = P THEN
  72                NULL;
  73           ELSE
  74                FAILED ( "'ABS' TEST FOR P - 2" );
  75           END IF;
  76
  77           IF "ABS" (N) = -N THEN
  78                NULL;
  79           ELSE
  80                FAILED ( "'ABS' TEST FOR N - 2 " );
  81           END IF;
  82
  83           IF "ABS" (Z) = Z THEN
  84                NULL;
  85           ELSE
  86                FAILED ( "'ABS' TEST FOR Z - 3" );
  87           END IF;
  88
  89           IF ABS (IDENT_INT (-INTEGER'LAST)) = INTEGER'LAST THEN
  90                NULL;
  91           ELSE
  92                FAILED ( "'ABS' TEST FOR -INTEGER'LAST" );
  93           END IF;
  94      END;
  95
  96      RESULT;
  97
  98 END C45631A;