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/] [c7/] [c74401e.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C74401E.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 OUT PARAMETERS HAVING A LIMITED PRIVATE TYPE CAN BE
26
-- DECLARED IN A PACKAGE SPECIFICATION, INCLUDING WITHIN PACKAGES
27
-- NESTED IN A VISIBLE PART.
28
 
29
-- CHECK THAT A RENAMING DECLARATION CAN RENAME A PROCEDURE DECLARED
30
-- WITH AN OUT PARAMETER.
31
 
32
-- JBG 5/1/85
33
 
34
WITH REPORT; USE REPORT;
35
PROCEDURE C74401E IS
36
 
37
     PACKAGE PKG IS
38
          TYPE LP IS LIMITED PRIVATE;
39
          PROCEDURE P20 (X : OUT LP);        -- OK.
40
          PROCEDURE RESET (X : OUT LP);
41
          FUNCTION EQ (L, R : LP) RETURN BOOLEAN;
42
          VAL1 : CONSTANT LP;
43
 
44
          PACKAGE NESTED IS
45
               PROCEDURE NEST1 (X : OUT LP);
46
          PRIVATE
47
               PROCEDURE NEST2 (X : OUT LP);
48
          END NESTED;
49
     PRIVATE
50
          TYPE LP IS NEW INTEGER;
51
          VAL1 : CONSTANT LP := LP(IDENT_INT(3));
52
     END PKG;
53
 
54
     VAR : PKG.LP;
55
 
56
     PACKAGE BODY PKG IS
57
          PROCEDURE P20 (X : OUT LP) IS
58
          BEGIN
59
               X := 3;
60
          END P20;
61
 
62
          PROCEDURE RESET (X : OUT LP) IS
63
          BEGIN
64
               X := LP(IDENT_INT(0));
65
          END RESET;
66
 
67
          FUNCTION EQ (L, R : LP) RETURN BOOLEAN IS
68
          BEGIN
69
               RETURN L = R;
70
          END EQ;
71
 
72
          PACKAGE BODY NESTED IS
73
               PROCEDURE NEST1 (X : OUT LP) IS
74
               BEGIN
75
                    X := 3;
76
               END NEST1;
77
 
78
               PROCEDURE NEST2 (X : OUT LP) IS
79
               BEGIN
80
                    X := LP(IDENT_INT(3));
81
               END NEST2;
82
          END NESTED;
83
     BEGIN
84
          VAR := LP(IDENT_INT(0));
85
     END PKG;
86
 
87
     PACKAGE PKG1 IS
88
          PROCEDURE P21 (X : OUT PKG.LP) RENAMES PKG.P20;   -- OK:
89
                                                            -- RENAMING.
90
     END PKG1;
91
 
92
BEGIN
93
 
94
     TEST ("C74401E", "CHECK THAT A PROCEDURE CAN HAVE AN OUT " &
95
                      "PARAMETER WITH A LIMITED PRIVATE TYPE");
96
 
97
     PKG.RESET (VAR);
98
     PKG.P20 (VAR);
99
 
100
     IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
101
          FAILED ("DIRECT CALL NOT CORRECT");
102
     END IF;
103
 
104
     PKG.RESET (VAR);
105
     PKG1.P21 (VAR);
106
 
107
     IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
108
          FAILED ("RENAMED CALL NOT CORRECT");
109
     END IF;
110
 
111
     PKG.RESET (VAR);
112
     PKG.NESTED.NEST1 (VAR);
113
 
114
     IF NOT PKG.EQ (VAR, PKG.VAL1) THEN
115
          FAILED ("NESTED CALL NOT CORRECT");
116
     END IF;
117
 
118
     RESULT;
119
 
120
END C74401E;

powered by: WebSVN 2.1.0

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