Subversion Repositories openrisc_me

-- CA15003.A

--                             Grant of Unlimited Rights

--

--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,

--     F08630-91-C-0015, and DCA100-97-D-0025, 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 WHATSOEVER, 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 10.1.5(4) and the modified 10.1.5(5)

--     from Technical Corrigendum 1. (Originally discussed as AI95-00136.)

--     Specifically:

--     Check that program unit pragma for a generic package are accepted

--     when given at the beginning of the package specification.

--     Check that a program unit pragma can be given for a generic

--     instantiation by placing the pragma immediately after the instantation.

--

-- TEST DESCRIPTION

--     This test checks the cases that are *not* forbidden by the RM,

--     and makes sure such legal cases actually work.

--

-- CHANGE HISTORY:

--      29 JUN 1999   RAD   Initial Version

--      08 JUL 1999   RLB   Cleaned up and added to test suite.

--      27 AUG 1999   RLB   Repaired errors introduced by me.

--

--!

with System;

package CA15003A is

    pragma Pure;

    type Big_Int is range -System.Max_Int .. System.Max_Int;

    type Big_Positive is new Big_Int range 1..Big_Int'Last;

end CA15003A;

generic

    type Int is new Big_Int;

package CA15003A.Pure is

    pragma Pure;

    function F(X: access Int) return Int;

end CA15003A.Pure;

with CA15003A.Pure;

package CA15003A.Pure_Instance is new CA15003A.Pure(Int => Big_Positive);

    pragma Pure(CA15003A.Pure_Instance);

package body CA15003A.Pure is

    function F(X: access Int) return Int is

    begin

        X.all := X.all + 1;

        return X.all;

    end F;

end CA15003A.Pure;

generic

package CA15003A.Pure.Preelaborate is

    pragma Preelaborate;

    One: Int := 1;

    function F(X: access Int) return Int;

end CA15003A.Pure.Preelaborate;

package body CA15003A.Pure.Preelaborate is

    function F(X: access Int) return Int is

    begin

        X.all := X.all + One;

        return X.all;

    end F;

end CA15003A.Pure.Preelaborate;

with CA15003A.Pure_Instance;

with CA15003A.Pure.Preelaborate;

package CA15003A.Pure_Preelaborate_Instance is

    new CA15003A.Pure_Instance.Preelaborate;

        pragma Preelaborate(CA15003A.Pure_Preelaborate_Instance);

package CA15003A.Empty_Pure is

    pragma Pure;

    pragma Elaborate_Body;

end CA15003A.Empty_Pure;

package body CA15003A.Empty_Pure is

end CA15003A.Empty_Pure;

package CA15003A.Empty_Preelaborate is

    pragma Preelaborate;

    pragma Elaborate_Body;

    One: Big_Int := 1;

end CA15003A.Empty_Preelaborate;

package body CA15003A.Empty_Preelaborate is

    function F(X: access Big_Int) return Big_Int is

    begin

        X.all := X.all + One;

        return X.all;

    end F;

end CA15003A.Empty_Preelaborate;

package CA15003A.Empty_Elaborate_Body is

    pragma Elaborate_Body;

    Three: aliased Big_Positive := 1;

    Two, Tres: Big_Positive'Base := 0;

end CA15003A.Empty_Elaborate_Body;

with Report; use Report; pragma Elaborate_All(Report);

with CA15003A.Pure_Instance;

with CA15003A.Pure_Preelaborate_Instance;

use CA15003A;

package body CA15003A.Empty_Elaborate_Body is

begin

    if Two /= Big_Positive'Base(Ident_Int(0)) then

        Failed ("Two should be zero now");

    end if;

    if Tres /= Big_Positive'Base(Ident_Int(0)) then

        Failed ("Tres should be zero now");

    end if;

    if Two /= Tres then

        Failed ("Tres should be zero now");

    end if;

    Two := Pure_Instance.F(Three'Access);

    Tres := Pure_Preelaborate_Instance.F(Three'Access);

    if Two /= Big_Positive(Ident_Int(2)) then

        Failed ("Two should be 2 now");

    end if;

    if Tres /= Big_Positive(Ident_Int(3)) then

        Failed ("Tres should be 3 now");

    end if;

end CA15003A.Empty_Elaborate_Body;

with Report; use Report;

with CA15003A.Empty_Pure;

with CA15003A.Empty_Preelaborate;

with CA15003A.Empty_Elaborate_Body; use CA15003A.Empty_Elaborate_Body;

use type CA15003A.Big_Positive'Base;

procedure CA15003 is

begin

    Test("CA15003", "Placement of Program Unit Pragmas in Generic Packages");

    if Two /= 2 then

        Failed ("Two should be 2 now");

    end if;

    if Tres /= 3 then

        Failed ("Tres should be 3 now");

    end if;

    Result;

end CA15003;