2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / gcc / testsuite / ada / acats / tests / c8 / c83007a.ada
blobf33d907af7b1b22800e61cd918bf4d10537337bc
1 -- C83007A.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 -- OBJECTIVE:
26 -- CHECK THAT A FORMAL PARAMETER OF A SUBPROGRAM DECLARED BY A
27 -- RENAMING DECLARATION CAN HAVE THE SAME IDENTIFIER AS A
28 -- DECLARATION IN THE BODY OF THE RENAMED SUBPROGRAM.
30 -- HISTORY:
31 -- VCL 02/18/88 CREATED ORIGINAL TEST.
34 WITH REPORT; USE REPORT;
35 PROCEDURE C83007A IS
36 BEGIN
37 TEST ("C83007A", "A FORMAL PARAMETER OF A SUBPROGRAM DECLARED " &
38 "BY A RENAMING DECLARATION CAN HAVE THE SAME " &
39 "IDENTIFIER AS A DECLARATION IN THE BODY OF " &
40 "THE RENAMED SUBPROGRAM");
41 DECLARE
42 PROCEDURE P (ONE : INTEGER; TWO : FLOAT; THREE : STRING);
44 PROCEDURE R (D1 : INTEGER;
45 D2 : FLOAT;
46 D3 : STRING) RENAMES P;
48 PROCEDURE P (ONE : INTEGER; TWO : FLOAT; THREE : STRING) IS
49 TYPE D1 IS RANGE 1..10;
50 I : D1 := D1(IDENT_INT (7));
52 D2 : FLOAT;
54 FUNCTION D3 RETURN STRING IS
55 BEGIN
56 RETURN "D3";
57 END D3;
59 FUNCTION IDENT_FLOAT (VAL : FLOAT) RETURN FLOAT IS
60 BEGIN
61 IF EQUAL (3, 3) THEN
62 RETURN VAL;
63 ELSE
64 RETURN 0.0;
65 END IF;
66 END IDENT_FLOAT;
68 BEGIN
69 IF ONE /= 5 THEN
70 FAILED ("INCORRECT VALUE FOR PARAMETER ONE");
71 END IF;
72 IF TWO /= 4.5 THEN
73 FAILED ("INCORRECT VALUE FOR PARAMETER TWO");
74 END IF;
75 IF THREE /= "R1" THEN
76 FAILED ("INCORRECT VALUE FOR PARAMETER THREE");
77 END IF;
79 IF I /= 7 THEN
80 FAILED ("INCORRECT VALUE FOR OBJECT I");
81 END IF;
82 D2 := IDENT_FLOAT (3.5);
83 IF D2 /= 3.5 THEN
84 FAILED ("INCORRECT VALUE FOR OBJECT D2");
85 END IF;
86 IF D3 /= "D3" THEN
87 FAILED ("INCORRECT VALUE FOR FUNCTION D3");
88 END IF;
89 END P;
90 BEGIN
91 R (D1=>5, D2=>4.5, D3=>"R1");
92 END;
94 RESULT;
95 END C83007A;