gcc/testsuite/ada/acats/tests/c4/c455001.a

   1 -- C455001.A
   2
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and
   6 --     F08630-91-C-0015, the U.S. Government obtained unlimited rights in the
   7 --     software and documentation contained herein.  Unlimited rights are
   8 --     defined in DFAR 252.227-7013(a)(19).  By making this public release,
   9 --     the Government intends to confer upon all recipients unlimited rights
  10 --     equal to those held by the Government.  These rights include rights to
  11 --     use, duplicate, release or disclose the released technical data and
  12 --     computer software in whole or in part, in any manner and for any purpose
  13 --     whatsoever, and to have or permit others to do so.
  14 --
  15 --                                    DISCLAIMER
  16 --
  17 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  18 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  19 --     WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE
  20 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  21 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  22 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  23 --*
  24 --
  25 -- OBJECTIVE:
  26 --     Check that universal fixed multiplying operators can be used without
  27 --     a conversion in contexts where the result type is determined.
  28 --
  29 --     Note: This is intended to check the changes made to these operators
  30 --     in Ada 95; legacy tests should cover cases from Ada 83.
  31 --
  32 -- CHANGE HISTORY:
  33 --      18 MAR 99   RLB    Initial version
  34 --
  35 --!
  36
  37 with Report; use Report;
  38
  39 procedure C455001 is
  40
  41      type F1 is delta 2.0**(-1) range 0.0 .. 8.0;
  42
  43      type F2 is delta 2.0**(-2) range 0.0 .. 4.0;
  44
  45      type F3 is delta 2.0**(-3) range 0.0 .. 2.0;
  46
  47      A : F1;
  48      B : F2;
  49      C : F3;
  50
  51      type Fixed_Record is record
  52         D : F1;
  53         E : F2;
  54      end record;
  55
  56      R : Fixed_Record;
  57
  58      function Ident_Fix (X : F3) return F3 is
  59      begin
  60           if Equal(3,3) then
  61                return X;
  62           else
  63                return 0.0;
  64           end if;
  65      end Ident_Fix;
  66
  67 begin
  68      Test ("C455001", "Check that universal fixed multiplying operators " &
  69                       "can be used without a conversion in contexts where " &
  70                       "the result type is determined.");
  71
  72      A := 1.0; B := 1.0;
  73      C := A * B; -- Assignment context.
  74
  75      if C /= Ident_Fix(1.0) then
  76           Failed ("Incorrect results for multiplication (1) - result is " &
  77                   F3'Image(C));
  78      end if;
  79
  80      C := A / B;
  81
  82      if C /= Ident_Fix(1.0) then
  83           Failed ("Incorrect results for division (1) - result is " &
  84                   F3'Image(C));
  85      end if;
  86
  87      A := 2.5;
  88      C := A * 0.25;
  89
  90      if C /= Ident_Fix(0.625) then
  91           Failed ("Incorrect results for multiplication (2) - result is " &
  92                   F3'Image(C));
  93      end if;
  94
  95      C := A / 4.0;
  96
  97      if C /= Ident_Fix(0.625) then
  98           Failed ("Incorrect results for division (2) - result is " &
  99                   F3'Image(C));
 100      end if;
 101
 102      C := Ident_Fix(0.75);
 103      C := C * 0.5;
 104
 105      if C /= Ident_Fix(0.375) then
 106           Failed ("Incorrect results for multiplication (3) - result is " &
 107                   F3'Image(C));
 108      end if;
 109
 110      C := Ident_Fix(0.75);
 111      C := C / 0.5;
 112
 113      if C /= Ident_Fix(1.5) then
 114           Failed ("Incorrect results for division (3) - result is " &
 115                   F3'Image(C));
 116      end if;
 117
 118      A := 0.5; B := 0.3; -- Function parameter context.
 119      if Ident_Fix(A * B) not in Ident_Fix(0.125) .. Ident_Fix(0.25) then
 120           Failed ("Incorrect results for multiplication (4) - result is " &
 121                   F3'Image(A * B)); -- Exact = 0.15
 122      end if;
 123
 124      B := 0.8;
 125      if Ident_Fix(A / B) not in Ident_Fix(0.5) .. Ident_Fix(0.75) then
 126           Failed ("Incorrect results for division (4) - result is " &
 127                   F3'Image(A / B));
 128                 -- Exact = 0.625..., but B is only restricted to the range
 129                 -- 0.75 .. 1.0, so the result can be anywhere in the range
 130                 -- 0.5 .. 0.75.
 131      end if;
 132
 133      C := 0.875; B := 1.5;
 134      R := (D => C * 4.0, E => B / 0.5); -- Aggregate context.
 135
 136      if R.D /= 3.5 then
 137           Failed ("Incorrect results for multiplication (5) - result is " &
 138                   F1'Image(R.D));
 139      end if;
 140
 141      if R.E /= 3.0 then
 142           Failed ("Incorrect results for division (5) - result is " &
 143                   F2'Image(R.E));
 144      end if;
 145
 146      A := 0.5;
 147      C := A * F1'(B * 2.0); -- Qualified expression context.
 148
 149      if C /= Ident_Fix(1.5) then
 150           Failed ("Incorrect results for multiplication (6) - result is " &
 151                   F3'Image(C));
 152      end if;
 153
 154      A := 4.0;
 155      C := F1'(B / 0.5) / A;
 156
 157      if C /= Ident_Fix(0.75) then
 158           Failed ("Incorrect results for division (6) - result is " &
 159                   F3'Image(C));
 160      end if;
 161
 162      Result;
 163
 164 end C455001;