OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c6/] [c67005c.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C67005C.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 A DECLARATION OF "=" NEED NOT HAVE PARAMETERS
26
-- OF A LIMITED TYPE IN A RENAMING DECLARATION. THIS TEST CHECKS
27
-- ACCESS TYPES.
28
 
29
-- BRYCE BARDIN (HUGHES AIRCRAFT) 7/2/84
30
-- CPP 7/12/84
31
 
32
WITH REPORT;  USE REPORT;
33
PROCEDURE C67005C IS
34
 
35
     GENERIC
36
          TYPE T IS LIMITED PRIVATE;
37
          WITH FUNCTION EQUAL (LEFT, RIGHT : T) RETURN BOOLEAN IS <>;
38
     PACKAGE EQUALITY IS
39
          FUNCTION "=" (LEFT, RIGHT : T) RETURN BOOLEAN;
40
          -- PRAGMA INLINE ("=");
41
     END EQUALITY;
42
 
43
     PACKAGE BODY EQUALITY IS
44
          FUNCTION "=" (LEFT, RIGHT : T) RETURN BOOLEAN IS
45
          BEGIN
46
               RETURN EQUAL (LEFT, RIGHT);
47
          END "=";
48
     END EQUALITY;
49
 
50
     PACKAGE STARTER IS
51
          TYPE INT IS PRIVATE;
52
          FUNCTION VALUE_OF (I : INTEGER) RETURN INT;
53
          FUNCTION EQUAL (LEFT, RIGHT : INT) RETURN BOOLEAN;
54
     PRIVATE
55
          TYPE INT IS ACCESS INTEGER;
56
     END STARTER;
57
 
58
     PACKAGE BODY STARTER IS
59
          FUNCTION VALUE_OF (I : INTEGER) RETURN INT IS
60
          BEGIN
61
               RETURN NEW INTEGER'(I);
62
          END VALUE_OF;
63
 
64
          FUNCTION EQUAL (LEFT, RIGHT : INT) RETURN BOOLEAN IS
65
          BEGIN
66
               RETURN LEFT.ALL = RIGHT.ALL;
67
          END EQUAL;
68
     END STARTER;
69
 
70
     PACKAGE ABSTRACTION IS
71
          TYPE INT IS NEW STARTER.INT;
72
          PACKAGE INT_EQUALITY IS NEW EQUALITY (INT, EQUAL);
73
          FUNCTION "=" (LEFT, RIGHT : INT) RETURN BOOLEAN
74
               RENAMES INT_EQUALITY."=";
75
     END ABSTRACTION;
76
     USE ABSTRACTION;
77
 
78
BEGIN
79
 
80
     TEST ("C67005C", "RENAMING OF EQUALITY OPERATOR WITH " &
81
           "NON-LIMITED PARAMETERS");
82
 
83
     DECLARE
84
 
85
          I : INT := VALUE_OF(1);
86
          J : INT := VALUE_OF(0);
87
 
88
          PROCEDURE CHECK (B : BOOLEAN) IS
89
          BEGIN
90
               IF I = J AND B THEN
91
                    COMMENT ("I = J");
92
               ELSIF I /= J AND NOT B THEN
93
                    COMMENT ("I /= J");
94
               ELSE
95
                    FAILED ("WRONG ""="" OPERATOR");
96
               END IF;
97
          END CHECK;
98
 
99
     BEGIN
100
 
101
          CHECK(FALSE);
102
          I := VALUE_OF(0);
103
          CHECK(TRUE);
104
 
105
          RESULT;
106
 
107
     END;
108
 
109
END C67005C;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.