From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/ada/acats/tests/ca/ca21001.a | 152 +++++++++++++++++++++++++++++ 1 file changed, 152 insertions(+) create mode 100644 gcc/testsuite/ada/acats/tests/ca/ca21001.a (limited to 'gcc/testsuite/ada/acats/tests/ca/ca21001.a') diff --git a/gcc/testsuite/ada/acats/tests/ca/ca21001.a b/gcc/testsuite/ada/acats/tests/ca/ca21001.a new file mode 100644 index 000000000..1056b65bf --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ca/ca21001.a @@ -0,0 +1,152 @@ +-- CA21001.A +-- +-- Grant of Unlimited Rights +-- +-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and +-- F08630-91-C-0015, the U.S. Government obtained unlimited rights in the +-- software and documentation contained herein. Unlimited rights are +-- defined in DFAR 252.227-7013(a)(19). By making this public release, +-- the Government intends to confer upon all recipients unlimited rights +-- equal to those held by the Government. These rights include rights to +-- use, duplicate, release or disclose the released technical data and +-- computer software in whole or in part, in any manner and for any purpose +-- whatsoever, and to have or permit others to do so. +-- +-- DISCLAIMER +-- +-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR +-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED +-- WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE +-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE +-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A +-- PARTICULAR PURPOSE OF SAID MATERIAL. +--* +-- +-- OBJECTIVE +-- Check the requirements of the revised 10.2.1(11) from Technical +-- Corrigendum 1 (originally discussed as AI95-00002). +-- A package subunit whose parent is a preelaborated subprogram need +-- not be preelaborable. +-- +-- TEST DESCRIPTION +-- We create several preelaborated library procedures with +-- non-preelaborable package body subunits. We try various levels +-- of nesting of package and procedure subunits. +-- +-- CHANGE HISTORY: +-- 29 JUN 1999 RAD Initial Version +-- 23 SEP 1999 RLB Improved comments, renamed, issued. +-- +--! + +procedure CA21001_1(X: out Integer); + pragma Preelaborate(CA21001_1); + +procedure CA21001_1(X: out Integer) is + function F return Integer is separate; + + package Sub is + function G(X: Integer) return Integer; + -- Returns X + 1. + Not_Preelaborable: Integer := F; -- OK, by AI-2. + end Sub; + + package body Sub is separate; + +begin + X := -1; + X := F; + X := Sub.G(X); +end CA21001_1; + +separate(CA21001_1) +package body Sub is + package Sub_Sub is + -- Empty. + end Sub_Sub; + package body Sub_Sub is separate; + + function G(X: Integer) return Integer is separate; +begin + Not_Preelaborable := G(F); -- OK, by AI-2. + if Not_Preelaborable /= 101 then + raise Program_Error; -- Can't call Report.Failed, here, + -- because Report is not preelaborated. + end if; +end Sub; + +separate(CA21001_1.Sub) +package body Sub_Sub is +begin + X := X; -- OK by AI-2. +end Sub_Sub; + +separate(CA21001_1.Sub) +function G(X: Integer) return Integer is + + package G_Sub is + function H(X: Integer) return Integer; + -- Returns X + 1. + Not_Preelaborable: Integer := F; -- OK, by AI-2. + end G_Sub; + package body G_Sub is separate; + +begin + return G_Sub.H(X); +end G; + +separate(CA21001_1.Sub.G) +package body G_Sub is + function H(X: Integer) return Integer is separate; +begin + Not_Preelaborable := H(F); -- OK, by AI-2. + if Not_Preelaborable /= 101 then + raise Program_Error; -- Can't call Report.Failed, here, + -- because Report is not preelaborated. + end if; +end G_Sub; + +separate(CA21001_1.Sub.G.G_Sub) +function H(X: Integer) return Integer is +begin + return X + 1; +end H; + +separate(CA21001_1) +function F return Integer is + + package F_Sub is + -- Empty. + end F_Sub; + + package body F_Sub is separate; +begin + return 100; +end F; + +separate(CA21001_1.F) +package body F_Sub is + True_Var: Boolean; +begin + True_Var := True; + if True_Var then -- OK by AI-2. + X := X; + else + X := X + 2; + end if; +end F_Sub; + +with Report; use Report; +with CA21001_1; +procedure CA21001 is + X: Integer := 0; +begin + Test("CA21001", + "Test that a package subunit whose parent is a preelaborated" + & " subprogram need not be preelaborable"); + CA21001_1(X); + if X /= 101 then + Failed("Bad value for X"); + end if; + Result; +end CA21001; -- cgit v1.2.3