2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / gcc / testsuite / ada / acats / tests / a / a83a02a.ada
blob45bdfad04ef7e95254fe40a67aa600f53a550fea
1 -- A83A02A.ADA
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.
16 -- DISCLAIMER
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 LABEL IN A NESTED SUBPROGRAM OR PACKAGE CAN BE IDENTICAL
26 -- TO A LABEL OUTSIDE SUCH CONSTRUCT.
29 -- "INSIDE LABEL": INSIDE * PACKAGE _PACK A
30 -- * FUNCTION INSIDE PACKAGE _PACKFUN B
31 -- * PROCEDURE _PROC C
32 -- * PROCEDURE INSIDE BLOCK _BLOCKPROC D
34 -- "OUTSIDE LABEL": INSIDE * MAIN _MAIN 1
35 -- * BLOCK IN MAIN _BLOCK 2
36 -- * LOOP IN BLOCK IN MAIN _BLOCKLOOP 3
37 -- * LOOP IN MAIN _LOOP 4
39 -- CASES TESTED: A1 B2 A3 B4 1 2 3 4
40 -- D1 C2 C3 D4
41 -- D2 AB A X . X .
42 -- B . X . X
43 -- C . X X .
44 -- D X . . X
47 -- RM 02/09/80
50 WITH REPORT ;
51 PROCEDURE A83A02A IS
53 USE REPORT ;
55 PROCEDURE PROC1 IS
56 BEGIN
57 << LAB_PROC_BLOCK >> NULL ; -- C2 C
58 << LAB_PROC_BLOCKLOOP >> NULL ; -- C3
59 END PROC1 ;
61 PACKAGE PACK1 IS
62 FUNCTION F RETURN INTEGER ;
63 END PACK1 ;
65 PACKAGE BODY PACK1 IS
66 FUNCTION F RETURN INTEGER IS
67 BEGIN
68 << LAB_PACKFUN_BLOCK >> NULL ; -- B2 B
69 << LAB_PACKFUN_LOOP >> NULL ; -- B4
70 << LAB_PACKFUN_PACK >> NULL ; -- BA (AB)
71 RETURN 7 ;
72 END F ;
73 BEGIN
74 << LAB_PACK_MAIN >> NULL ; -- A1 A
75 << LAB_PACK_BLOCKLOOP >> NULL ; -- A3
76 << LAB_PACKFUN_PACK >> NULL ; -- BA (AB)
77 END PACK1 ;
79 BEGIN
81 TEST( "A83A02A" , "CHECK THAT A LABEL IN A NESTED SUBPROGRAM" &
82 " OR PACKAGE CAN BE IDENTICAL TO A LABEL" &
83 " OUTSIDE SUCH CONSTRUCT" );
85 << LAB_PACK_MAIN >> NULL ; -- A1 1
86 << LAB_BLOCKPROC_MAIN >> NULL ; -- D1
89 DECLARE --
91 PROCEDURE PROC2 IS
92 BEGIN
93 << LAB_BLOCKPROC_MAIN >> NULL ; -- D1 D
94 << LAB_BLOCKPROC_LOOP >> NULL ; -- D4
95 << LAB_BLOCKPROC_BLOCK >> NULL ; -- D2
96 END PROC2 ;
98 BEGIN
100 << LAB_PACKFUN_BLOCK >> NULL ; -- B2 2
101 << LAB_PROC_BLOCK >> NULL ; -- C2
102 << LAB_BLOCKPROC_BLOCK >> NULL ; -- D2
104 FOR I IN 1..2 LOOP
105 << LAB_PACK_BLOCKLOOP >> NULL ; -- A3 3
106 << LAB_PROC_BLOCKLOOP >> NULL ; -- C3
107 END LOOP;
109 END ;
111 FOR I IN 1..2 LOOP
112 << LAB_PACKFUN_LOOP >> NULL ; -- B4 4
113 << LAB_BLOCKPROC_LOOP >> NULL ; -- D4
114 END LOOP;
117 RESULT ;
120 END A83A02A ;