diff gcc/testsuite/ada/acats/tests/ca/ca21001.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/ca/ca21001.a	Fri Oct 27 22:46:09 2017 +0900
@@ -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;