Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/l/la140202.am @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- LA140202.AM
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 --
26 -- OBJECTIVE:
27 -- Check that a compilation unit may not depend semantically
28 -- on two different versions of the same compilation unit.
29 -- Check the case where a library level instance depends on
30 -- a library level generic function whose body is changed.
31 --
32 -- TEST DESCRIPTION:
33 -- This test compiles a generic function, an instance of a generic
34 -- function that withs the first function and a main procedure that
35 -- withs the instance. Then a new version of the first generic function
36 -- is compiled (in a separate file, simulating editing and modification
37 -- of the unit). Unless automatic recompilation is supported, this
38 -- test should fail to link. Otherwise, the test should recompile and
39 -- link the correct version of the withed function and report "PASSED"
40 -- at execution time.
41 --
42 -- SPECIAL REQUIREMENTS:
43 -- To build this test:
44 -- 1) Compile the file LA140200 (and include the results in the
45 -- program library).
46 -- 2) Compile the file LA140201 (and include the results in the
47 -- program library).
48 -- 3) Compile the file LA140202 (and include the results in the
49 -- program library).
50 -- 4) Compile the file LA140203 (and include the results in the
51 -- program library).
52 -- 5) Attempt to build an executable image.
53 -- 6) If an executable image results, run it.
54 --
55 -- TEST FILES:
56 -- This test consists of the following files:
57 -- LA140200.A
58 -- LA140201.A
59 -- -> LA140202.AM
60 -- LA140203.A
61 --
62 -- PASS/FAIL CRITERIA:
63 -- The test passes if a link time error message reports that
64 -- LA140202 is missing or obsolete, or that LA14020_3 or LA14020_4
65 -- is missing or obsolete (optional) and no executable image
66 -- results. The test passes if an executable image is produced
67 -- and reports "PASSED" (in the case where the implementation
68 -- supports automatic recompilation).
69 --
70 --
71 -- CHANGE HISTORY:
72 -- 01 MAY 95 ACVC 1.12 LA5008Q baseline version
73 -- 23 JUN 95 SAIC Initial version
74 -- 29 FEB 96 SAIC First revision after review
75 -- 12 DEC 96 SAIC Reorganized to permit automatic recompilation.
76 -- Reworded objective. Moved instance to
77 -- library-level and redesigned to use generic
78 -- formal function. Fixed arithmetic errors.
79 --
80 --!
81
82 with LA14020_0.LA14020_1;
83 with LA14020_2;
84 pragma Elaborate (LA14020_2);
85 function LA14020_3 is new LA14020_2 (LA14020_0.LA14020_1.Bigger_Basket);
86
87 --==================================================================--
88
89 with LA14020_0.LA14020_1;
90 generic
91 type Market_Basket is new LA14020_0.LA14020_1.Bigger_Basket with private;
92 with function "+" (L,R: Market_Basket) return Market_Basket is <>;
93 function LA14020_4 (B1, B2 : Market_Basket) return Market_Basket;
94
95 --==================================================================--
96
97 with LA14020_3;
98 function LA14020_4 (B1, B2 : Market_Basket) return Market_Basket is
99 Result : Market_Basket;
100 begin
101 Result := B1 + B2;
102 Result.Total := integer (Result.App) + integer (Result.Ora);
103 return Result;
104 end LA14020_4;
105
106 --==================================================================--
107
108 with Report;
109
110 with LA14020_0.LA14020_1;
111 with LA14020_3;
112 with LA14020_4;
113
114 procedure LA140202 is
115 package Child renames LA14020_0.LA14020_1;
116
117 Basket_1 : Child.Bigger_Basket := (App => 5, Ora => 20, Total => 0);
118 Basket_2 : Child.Bigger_Basket := (App => 7, Ora => 3, Total => 0);
119
120 function Total is new LA14020_4 (Child.Bigger_Basket, LA14020_3);
121 begin
122 Report.Test ("LA14020", "Check that a compilation unit may " &
123 "not depend semantically on two " &
124 "different versions of the same " &
125 "compilation unit. Check the case " &
126 "where a library level instance " &
127 "depends on a library level generic " &
128 "function whose body is changed");
129
130 Basket_1 := Total (Basket_1, Basket_2);
131
132 if Basket_1.App = 10 or
133 Basket_1.Ora = 6 or
134 Basket_1.Total = 16
135 then
136 Report.Failed ("Revised generic function not used");
137 elsif Basket_1.App /= 12 or
138 Basket_1.Ora /= 23 or
139 Basket_1.Total /= 35 then
140 Report.Failed ("Incorrect result returned");
141 end if;
142
143 Report.Result;
144 end LA140202;