1-- C456001.A
2--
3--                             Grant of Unlimited Rights
4--
5--     The Ada Conformity Assessment Authority (ACAA) holds unlimited
6--     rights in the software and documentation contained herein. Unlimited
7--     rights are the same as those granted by the U.S. Government for older
8--     parts of the Ada Conformity Assessment Test Suite, and are defined
9--     in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
10--     intends to confer upon all recipients unlimited rights equal to those
11--     held by the ACAA. These rights include rights to use, duplicate,
12--     release or disclose the released technical data and computer software
13--     in whole or in part, in any manner and for any purpose whatsoever, and
14--     to have or permit others to do so.
15--
16--                                    DISCLAIMER
17--
18--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19--     DISCLOSED ARE AS IS. THE ACAA 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--                                     Notice
26--
27--    The ACAA has created and maintains the Ada Conformity Assessment Test
28--    Suite for the purpose of conformity assessments conducted in accordance
29--    with the International Standard ISO/IEC 18009 - Ada: Conformity
30--    assessment of a language processor. This test suite should not be used
31--    to make claims of conformance unless used in accordance with
32--    ISO/IEC 18009 and any applicable ACAA procedures.
33--
34--*
35-- OBJECTIVE:
36--     For exponentiation of floating point types, check that
37--       Constraint_Error is raised (or, if no exception is raised and
38--       Machine_Overflows is False, that a result is produced) if the
39--       result is outside of the range of the base type.
40--     This tests digits 5.
41
42-- HISTORY:
43--     04/30/03  RLB  Created test from old C45622A and C45624A.
44
45with Report;
46
47procedure C456001 is
48
49     type Flt is digits 5;
50
51     F : Flt;
52
53     function Equal_Flt (One, Two : Flt) return Boolean is
54         -- Break optimization.
55     begin
56          return One = Two * Flt (Report.Ident_Int(1));
57     end Equal_Flt;
58
59begin
60     Report.Test ("C456001", "For exponentiation of floating point types, " &
61                      "check that Constraint_Error is raised (or, if " &
62                      "if no exception is raised and Machine_Overflows is " &
63                      "False, that a result is produced) if the result is " &
64                      "outside of the range of the base type.");
65
66     begin
67         F := (Flt'Base'Last)**Report.Ident_Int (2);
68         if Flt'Machine_Overflows Then
69             Report.Failed ("Constraint_Error was not raised for " &
70                       "exponentiation");
71         else
72             -- RM95 3.5.6(7) allows disobeying RM95 4.5(10) if
73             -- Machine_Overflows is False.
74             Report.Comment ("Constraint_Error was not raised for " &
75                       "exponentiation and Machine_Overflows is False");
76         end if;
77         if not Equal_Flt (F, F) then
78             -- Optimization breaker, F must be evaluated.
79             Report.Comment ("Don't optimize F");
80         end if;
81     exception
82         when Constraint_Error =>
83             Report.Comment ("Constraint_Error was raised for " &
84                             "exponentiation");
85         when others =>
86             Report.Failed ("An exception other than Constraint_Error " &
87                            "was raised for exponentiation");
88     end;
89
90     Report.Result;
91end C456001;
92