1-- C87B40A.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 FOLLOWING RULES:
26--
27-- THE SAME OPERATIONS ARE PREDEFINED FOR THE TYPE UNIVERSAL_INTEGER
28-- AS FOR ANY INTEGER TYPE. THE SAME OPERATIONS ARE PREDEFINED FOR THE
29-- TYPE UNIVERSAL_REAL AS FOR ANY FLOATING POINT TYPE. IN ADDITION
30-- THESE OPERATIONS INCLUDE THE FOLLOWING MULTIPLICATION AND DIVISION
31-- OPERATORS:
32--
33--   "*" (UNIVERSAL_REAL, UNIVERSAL_INTEGER) RETURN UNIVERSAL_REAL
34--   "*" (UNIVERSAL_INTEGER, UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
35--   "*" (UNIVERSAL_REAL,    UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
36--   "*" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
37--   "/" (UNIVERSAL_REAL, UNIVERSAL_INTEGER) RETURN UNIVERSAL_REAL
38--  "**" (UNIVERSAL_INTEGER, INTEGER) RETURN UNIVERSAL_INTEGER
39--  "**" (UNIVERSAL_REAL, INTEGER) RETURN UNIVERSAL_REAL
40-- "MOD" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
41-- "DIV" (UNIVERSAL_INTEGER, UNIVERSAL_INTEGER) RETURN UNIVERSAL_INTEGER
42-- "ABS" (UNIVERSAL_INTEGER) RETURN UNIVERSAL INTEGER
43-- "ABS" (UNIVERSAL_REAL) RETURN UNIVERSAL_REAL
44
45-- TRH  15 SEPT 82
46
47WITH REPORT; USE REPORT;
48
49PROCEDURE C87B40A IS
50
51     ERR : BOOLEAN := FALSE;
52     B : ARRAY (1 .. 12) OF BOOLEAN := (1 .. 12 => TRUE);
53
54     FUNCTION "-" (X : INTEGER) RETURN INTEGER
55          RENAMES STANDARD."+";
56
57     FUNCTION "+" (X : INTEGER) RETURN INTEGER IS
58     BEGIN
59          ERR := TRUE;
60          RETURN X;
61     END "+";
62
63     FUNCTION "+" (X : FLOAT) RETURN FLOAT IS
64     BEGIN
65          ERR := TRUE;
66          RETURN X;
67     END "+";
68
69BEGIN
70     TEST ("C87B40A","OVERLOADING RESOLUTION OF UNIVERSAL " &
71           "EXPRESSIONS");
72
73     B(1)  := 1.0 * (+1) IN 0.0 .. 0.0;       -- 1.0 * 1
74     B(2)  := (+1) * 1.0 IN 0.0 .. 0.0;       -- 1 * 1.0
75     B(3)  := 1.0 / (+1) IN 0.0 .. 0.0;       -- 1.0 / 1
76     B(4)  := (+1)  +  (+1) <= (+1)  -  (+1); -- 1+1< 1 - 1
77     B(5)  := (+1)  *  (+1) >  (+1)  /  (+1); -- 1*1 > 1/1
78     B(6)  := (+1) MOD (+1) /= (+1) REM (+1); -- 1 MOD 1 /= 1 REM 1
79
80     BEGIN
81          B(7)  := (+2) **  (-2) <  "-"  (-1);     -- 2**2 < 1
82     EXCEPTION
83          WHEN CONSTRAINT_ERROR =>
84               FAILED("INCORRECT RESOLUTION FOR INTEGER EXPONENT - 7");
85     END;
86
87     B(8)  := (+1) REM (+1) > "ABS" (+1);     -- 1 REM 1 > ABS 1
88     B(9)  := (+1.0)  +  (+1.0) <= (+1.0)  -  (+1.0); -- 2.0 <= 0.0
89     B(10) := (+1.0)  *  (+1.0) >  (+1.0)  /  (+1.0); -- 1.0 > 1.0
90     B(11) := (+2.0) **  (-1)   <  "-"  (-1.0);       -- 2.0 < 1.0
91     B(12) := (+2.0) **  (-1)  <= "ABS" (+1.0);       -- 2.0 <= 1.0
92
93     FOR I IN B'RANGE
94     LOOP
95          IF B(I) /= FALSE THEN
96               FAILED("RESOLUTION OR OPERATIONS INCORRECT FOR "
97               & "UNIVERSAL EXPRESSIONS - " & INTEGER'IMAGE(I) );
98          END IF;
99     END LOOP;
100
101     IF ERR THEN
102          FAILED ("RESOLUTION INCORRECT FOR UNIVERSAL EXPRESSIONS");
103     END IF;
104
105     RESULT;
106END C87B40A;
107