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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CC3120B.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 TASKS ARE NOT COPIED AS GENERIC IN OUT PARMS.
26
 
27
-- DAT 8/27/81
28
-- SPS 4/6/82
29
-- JBG 3/23/83
30
 
31
WITH REPORT; USE REPORT;
32
 
33
PROCEDURE CC3120B IS
34
BEGIN
35
     TEST ("CC3120B", "TASKS ARE NOT COPIED AS GENERIC PARAMETERS");
36
 
37
     DECLARE
38
          PACKAGE P IS
39
               TYPE T IS LIMITED PRIVATE;
40
               PROCEDURE UPDT (TPARM: IN T; I : IN OUT INTEGER);
41
          PRIVATE
42
               TASK TYPE T1 IS
43
                    ENTRY GET (I : OUT INTEGER);
44
                    ENTRY PUT (I : IN INTEGER);
45
               END T1;
46
               TYPE T IS RECORD
47
                    C : T1;
48
               END RECORD;
49
          END P;
50
          USE P;
51
          TT : T;
52
          GENERIC
53
               TYPE T IS LIMITED PRIVATE;
54
               T1 : IN OUT T;
55
               WITH PROCEDURE UPDT (TPARM : IN T; I: IN OUT INTEGER)
56
                    IS <> ;
57
          PROCEDURE PR;
58
 
59
          PROCEDURE PR IS
60
               I : INTEGER;
61
          BEGIN
62
               I := 5;
63
                                        -- PR.I
64
                                        -- UPDT.I      UPDT.T1.I
65
                                        --   5            4
66
               UPDT (T1, I);
67
                                        --   4            5
68
               IF I /= 4 THEN
69
                    FAILED ("BAD VALUE 1");
70
               END IF;
71
               I := 6;
72
                                        --   6            5
73
               UPDT (T1, I);
74
                                        --   5            6
75
               IF I /= 5 THEN
76
                    FAILED ("BAD VALUE 3");
77
               END IF;
78
               RAISE TASKING_ERROR;
79
               FAILED ("INCORRECT RAISE STATEMENT");
80
          END PR;
81
 
82
          PACKAGE BODY P IS
83
               PROCEDURE UPDT (TPARM : IN T; I : IN OUT INTEGER) IS
84
                    V : INTEGER := I;
85
                    -- UPDT.I => V
86
                    -- T1.I => UPDT.I
87
                    -- V => T1.I
88
               BEGIN
89
                    TPARM.C.GET (I);
90
                    TPARM.C.PUT (V);
91
               END UPDT;
92
 
93
               TASK BODY T1 IS
94
                    I : INTEGER;
95
               BEGIN
96
                    I := 1;
97
                    LOOP
98
                         SELECT
99
                              ACCEPT GET (I : OUT INTEGER) DO
100
                                   I := T1.I;
101
                              END GET;
102
                         OR
103
                              ACCEPT PUT (I : IN INTEGER) DO
104
                                   T1.I := I;
105
                              END PUT;
106
                         OR
107
                              TERMINATE;
108
                         END SELECT;
109
                    END LOOP;
110
               END T1;
111
          END P;
112
     BEGIN
113
          DECLARE
114
               X : INTEGER := 2;
115
               PROCEDURE PPP IS NEW PR (T, TT);
116
          BEGIN
117
                                        -- X
118
                                        -- UPDT.I      UPDT.T1.I
119
                                        --   2            1
120
               UPDT (TT, X);
121
                                        --   1            2
122
               X := X + 3;
123
                                        --   4            2
124
               UPDT (TT, X);
125
                                        --   2            4
126
               IF X /= 2 THEN
127
                    FAILED ("WRONG VALUE FOR X");
128
               END IF;
129
               BEGIN
130
                    PPP;
131
                    FAILED ("PPP NOT CALLED");
132
               EXCEPTION
133
                    WHEN TASKING_ERROR => NULL;
134
               END;
135
               X := 12;
136
                                        --   12           6
137
               UPDT (TT, X);
138
                                        --   6            12
139
               IF X /= 6 THEN
140
                    FAILED ("WRONG FINAL VALUE IN TASK");
141
               END IF;
142
          END;
143
     END;
144
 
145
     RESULT;
146
END CC3120B;

powered by: WebSVN 2.1.0

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