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

   1 -- C490003.A
   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 --
  26 -- OBJECTIVE:
  27 --      Check that a static expression is legal if its evaluation fails
  28 --      no language-defined check other than Overflow_Check. Check that such
  29 --      a static expression is legal if it is part of a larger static
  30 --      expression, even if its value is outside the base range of the
  31 --      expected type.
  32 --
  33 --      Check that if a static expression is part of the right operand of a
  34 --      short circuit control form whose value is determined by its left
  35 --      operand, it is not evaluated.
  36 --
  37 --      Check that a static expression in a non-static context is evaluated
  38 --      exactly.
  39 --
  40 -- TEST DESCRIPTION:
  41 --      The first part of the objective is tested by constructing static
  42 --      expressions which involve predefined operations of integer, floating
  43 --      point, and fixed point subtypes. Intermediate expressions within the
  44 --      static expressions have values outside the base range of the expected
  45 --      type. In one case, the extended-range intermediates are compared as
  46 --      part of a boolean expression. In the remaining two cases, further
  47 --      predefined operations on the intermediates bring the final result
  48 --      within the base range. An implementation which compiles these static
  49 --      expressions satisfies this portion of the objective. A check is
  50 --      performed at run-time to ensure that the static expressions evaluate
  51 --      to values within the base range of their respective expected types.
  52 --
  53 --      The second part of the objective is tested by constructing
  54 --      short-circuit control forms whose left operands have the values
  55 --      shown below:
  56 --
  57 --         (TRUE)  or else  (...)
  58 --         (FALSE) and then (...)
  59 --
  60 --      In both cases the left operand determines the value of the condition.
  61 --      In the test each right operand involves a division by zero, which will
  62 --      raise Constraint_Error if evaluated. A check is made that no exception
  63 --      is raised when each short-circuit control form is evaluated, and that
  64 --      the value of the condition is that of the left operand.
  65 --
  66 --      The third part of the objective is tested by evaluating static
  67 --      expressions involving many operations in contexts which do not
  68 --      require a static expression, and verifying that the exact
  69 --      mathematical results are calculated.
  70 --
  71 --
  72 -- CHANGE HISTORY:
  73 --      15 Sep 95   SAIC    Initial prerelease version for ACVC 2.1.
  74 --      20 Oct 96   SAIC    Modified expressions in C490003_0 to avoid
  75 --                          the use of universal operands.
  76 --
  77 --!
  78
  79 with System;
  80 package C490003_0 is
  81
  82    type My_Flt is digits System.Max_Digits;
  83
  84    Flt_Range_Diff : My_Flt := (My_Flt'Base'Last - My_Flt'Base'First) -
  85                               (My_Flt'Last - My_Flt'First);           -- OK.
  86
  87
  88    type My_Fix is delta 0.125 range -128.0 .. 128.0;
  89
  90    Symmetric : Boolean := (My_Fix'Base'Last - My_Fix'Base'First) =
  91                           (My_Fix'Base'Last + My_Fix'Base'Last);      -- OK.
  92
  93
  94    Center : constant Integer := Integer'Base'Last -
  95                                  (Integer'Base'Last -
  96                                   Integer'Base'First) / 2;            -- OK.
  97
  98 end C490003_0;
  99
 100
 101      --==================================================================--
 102
 103
 104 with Ada.Numerics;
 105 package C490003_1 is
 106
 107    Zero       : constant := 0.0;
 108    Pi         : constant := Ada.Numerics.Pi;
 109
 110    Two_Pi     : constant := 2.0 * Pi;
 111    Half_Pi    : constant := Pi/2.0;
 112
 113    Quarter    : constant := 90.0;
 114    Half       : constant := 180.0;
 115    Full       : constant := 360.0;
 116
 117    Deg_To_Rad : constant := Half_Pi/90;
 118    Rad_To_Deg : constant := 1.0/Deg_To_Rad;
 119
 120 end C490003_1;
 121
 122
 123      --==================================================================--
 124
 125
 126 with C490003_0;
 127 with C490003_1;
 128
 129 with Report;
 130 procedure C490003 is
 131 begin
 132    Report.Test ("C490003", "Check that static expressions failing "          &
 133                 "Overflow_Check are legal if part of a larger static "       &
 134                 "expression. Check that static expressions as right "        &
 135                 "operands of short-circuit control forms are not "           &
 136                 "evaluated if value of control form is determined by "       &
 137                 "left operand. Check that static expressions in non-static " &
 138                 "contexts are evaluated exactly");
 139
 140
 141 --
 142 -- Static expressions within larger static expressions:
 143 --
 144
 145
 146    if C490003_0.Flt_Range_Diff not in C490003_0.My_Flt'Base'Range then
 147       Report.Failed ("Error evaluating static expression: floating point");
 148    end if;
 149
 150    if C490003_0.Symmetric not in Boolean'Range then
 151       Report.Failed ("Error evaluating static expression: fixed point");
 152    end if;
 153
 154    if C490003_0.Center not in Integer'Base'Range then
 155       Report.Failed ("Error evaluating static expression: integer");
 156    end if;
 157
 158
 159 --
 160 -- Short-circuit control forms:
 161 --
 162
 163    declare
 164       N : constant := 0.0;
 165    begin
 166
 167       begin
 168          if not ( (N = 0.0) or else (1.0/N > 0.5) ) then
 169             Report.Failed ("Error evaluating OR ELSE");
 170          end if;
 171       exception
 172          when Constraint_Error =>
 173             Report.Failed ("Right side of OR ELSE was evaluated");
 174          when others           =>
 175             Report.Failed ("OR ELSE: unexpected exception raised");
 176       end;
 177
 178       begin
 179          if (N /= 0.0) and then (1.0/N <= 0.5) then
 180             Report.Failed ("Error evaluating AND THEN");
 181          end if;
 182       exception
 183          when Constraint_Error =>
 184             Report.Failed ("Right side of AND THEN was evaluated");
 185          when others           =>
 186             Report.Failed ("AND THEN: unexpected exception raised");
 187       end;
 188
 189    end;
 190
 191
 192 --
 193 -- Exact evaluation of static expressions:
 194 --
 195
 196
 197    declare
 198       use C490003_1;
 199
 200       Left  : constant := 6.0 + 0.3125*( (Full*0.375) + (Half/2.4) -
 201                              ((Quarter + 36.0)/3.0) )/10.0;            -- 11.25
 202       Right : constant := (Pi/3.0) * 1.2 * (15.0/96.0);                -- Pi/16
 203    begin
 204       if Deg_To_Rad*Left /= Right then
 205          Report.Failed ("Static expressions not evaluated exactly: #1");
 206       end if;
 207
 208       if ((Pi*Rad_To_Deg)*2.0 + 4.0*Quarter)/16.0 /= Rad_To_Deg*(Pi/4.0) then
 209          Report.Failed ("Static expressions not evaluated exactly: #2");
 210       end if;
 211    end;
 212
 213
 214    Report.Result;
 215 end C490003;