Subversion Repositories openrisc_me

-- CXH1001.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 pragma Normalize_Scalars.

--     Check that this configuration pragma causes uninitialized scalar

--     objects to be set to a predictable value.  Check that multiple

--     compilation units are affected.  Check for uninitialized scalar

--     objects that are subcomponents of composite objects, unassigned

--     out parameters, objects that have been allocated without an initial

--     value, and objects that are stand alone.

--

-- TEST DESCRIPTION

--     The test requires that the configuration pragma Normalize_Scalars

--     be processed.  It then defines a few scalar types (some enumeration,

--     some integer) in a few packages.  The scalar types are designed such

--     that the representation will easily allow for an out of range value.

--     Unchecked_Conversion and the 'Valid attribute are both used to verify

--     that the default values of the various kinds of objects are indeed

--     invalid for the type.

--

--     Note that this test relies on having uninitialized objects, compilers

--     may generate several warnings to this effect.

--

-- SPECIAL REQUIREMENTS

--      The implementation must process configuration pragmas which

--      are not part of any Compilation Unit;  the method employed

--      is implementation defined.

--

-- APPLICABILITY CRITERIA:

--      This test is only applicable for a compiler attempting validation

--      for the Safety and Security Annex.

--

--

-- CHANGE HISTORY:

--      26 OCT 95   SAIC   Initial version

--      04 NOV 96   SAIC   Added cases, upgraded commentary

--

--!

---------------------------- CONFIGURATION PRAGMAS -----------------------

pragma Normalize_Scalars;                                         -- OK

                                                -- configuration pragma

------------------------ END OF CONFIGURATION PRAGMAS --------------------

----------------------------------------------------------------- CXH1001_0

with Impdef.Annex_H;

with Unchecked_Conversion;

package CXH1001_0 is

  package Imp_H renames Impdef.Annex_H;

  use type Imp_H.Small_Number;

  use type Imp_H.Scalar_To_Normalize;

  Global_Object : Imp_H.Scalar_To_Normalize;

  -- if the pragma is in effect, this should come up with the predictable

  -- value

  Global_Number : Imp_H.Small_Number;

  -- if the pragma is in effect, this should come up with the predictable

  -- value

  procedure Package_Check;

  type Num is range 0..2**Imp_H.Scalar_To_Normalize'Size-1;

  for Num'Size use Imp_H.Scalar_To_Normalize'Size;

  function STN_2_Num is

     new Unchecked_Conversion( Imp_H.Scalar_To_Normalize, Num );

  Small_Last : constant Integer := Integer(Imp_H.Small_Number'Last);

end CXH1001_0;

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

with Report;

package body CXH1001_0 is

  procedure Heap_Check( A_Value  : access Imp_H.Scalar_To_Normalize;

                        A_Number : access Imp_H.Small_Number ) is

    Value  : Num;

    Number : Integer;

  begin

    if A_Value.all'Valid then

      Value := STN_2_Num ( A_Value.all );

      if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then

        if Imp_H.Scalar_To_Normalize'Val(Value)

           /= Imp_H.Default_For_Scalar_To_Normalize then

          Report.Failed("Implicit initial value for local variable is not "

                         & "the predicted value");

        end if;

      else

        if Value in 0 ..

            Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then

          Report.Failed("Implicit initial value for local variable is a "

                         & "value of the type");

        end if;

      end if;

    end if;

    if A_Number.all'Valid then

      Number := Integer( A_Number.all );

      if Imp_H.Default_For_Small_Number_Is_In_Range then

        if Global_Number /= Imp_H.Default_For_Small_Number then

          Report.Failed("Implicit initial value for number is not "

                         & "the predicted value");

        end if;

      else

        if Integer( Global_Number ) in 0 .. Report.Ident_Int(Small_Last) then

          Report.Failed("Implicit initial value for number is a "

                         & "value of the type");

        end if;

      end if;

    end if;

  end Heap_Check;

  procedure Package_Check is

    Value  : Num;

    Number : Integer;

  begin

    if Global_Object'Valid then

      Value := STN_2_Num ( Global_Object );

      if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then

        if Imp_H.Scalar_To_Normalize'Val(Value)

           /= Imp_H.Default_For_Scalar_To_Normalize then

          Report.Failed("Implicit initial value for local variable is not "

                         & "the predicted value");

        end if;

      else

        if Value in 0 ..

            Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then

          Report.Failed("Implicit initial value for local variable is a "

                         & "value of the type");

        end if;

      end if;

    end if;

    if Global_Number'Valid then

      Number := Integer( Global_Number );

      if Imp_H.Default_For_Small_Number_Is_In_Range then

        if Global_Number /= Imp_H.Default_For_Small_Number then

          Report.Failed("Implicit initial value for number is not "

                         & "the predicted value");

        end if;

      else

        if Integer( Global_Number ) in 0 .. Report.Ident_Int(Small_Last) then

          Report.Failed("Implicit initial value for number is a "

                         & "value of the type");

        end if;

      end if;

    end if;

    Heap_Check( new Imp_H.Scalar_To_Normalize, new Imp_H.Small_Number );

  end Package_Check;

end CXH1001_0;

----------------------------------------------------------------- CXH1001_1

with Unchecked_Conversion;

package CXH1001_0.CXH1001_1 is

  -- kill as many birds as possible with a single stone:

  --   embed a protected object in the body of a child package,

  -- checks the multiple compilation unit case,

  -- and part of the subcomponent case.

  protected Thingy is

    procedure Check_Embedded_Values;

  private

    Hidden_Object : Imp_H.Scalar_To_Normalize;  -- not initialized

    Hidden_Number : Imp_H.Small_Number;         -- not initialized

  end Thingy;

end CXH1001_0.CXH1001_1;

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

with Report;

package body CXH1001_0.CXH1001_1 is

  Childs_Object : Imp_H.Scalar_To_Normalize;  -- not initialized

  protected body Thingy is

    procedure Check_Embedded_Values is

    begin

      if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then

        if Childs_Object /= Imp_H.Default_For_Scalar_To_Normalize then

          Report.Failed("Implicit initial value for child object is not "

                         & "the predicted value");

        end if;

      elsif Childs_Object'Valid and then STN_2_Num( Childs_Object ) in 0 ..

            Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then

          Report.Failed("Implicit initial value for child object is a "

                         & "value of the type");

      end if;

      if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then

        if Hidden_Object /= Imp_H.Default_For_Scalar_To_Normalize then

          Report.Failed("Implicit initial value for protected package object "

                         & "is not the predicted value");

        end if;

      elsif Hidden_Object'Valid and then STN_2_Num( Hidden_Object ) in 0 ..

            Imp_H.Scalar_To_Normalize'Pos(Imp_H.Scalar_To_Normalize'Last) then

          Report.Failed("Implicit initial value for protected component "

                         & "is a value of the type");

      end if;

      if Imp_H.Default_For_Small_Number_Is_In_Range then

        if Hidden_Number /= Imp_H.Default_For_Small_Number then

          Report.Failed("Implicit initial value for protected number "

                         & "is not the predicted value");

        end if;

      elsif Hidden_Number'Valid and then Hidden_Number in

          Report.Failed("Implicit initial value for protected number "

                         & "is a value of the type");

      end if;

    end Check_Embedded_Values;

 end Thingy;

end CXH1001_0.CXH1001_1;

------------------------------------------------------------------- CXH1001

with Impdef.Annex_H;

with Report;

with CXH1001_0.CXH1001_1;

procedure CXH1001 is

  package Imp_H renames Impdef.Annex_H;

  use type CXH1001_0.Num;

  My_Object : Imp_H.Scalar_To_Normalize;  -- not initialized

  Value     : CXH1001_0.Num := CXH1001_0.STN_2_Num ( My_Object );

                               -- My_Object is not initialized

  Parameter_Value : Imp_H.Scalar_To_Normalize

                  := Imp_H.Scalar_To_Normalize'Last;

  type Structure is record  -- not initialized

    Std_Int : Integer;

    Scalar  : Imp_H.Scalar_To_Normalize;

    Num     : CXH1001_0.Num;

  end record;

  S : Structure;  -- not initialized

  procedure Bad_Code( Unassigned : out Imp_H.Scalar_To_Normalize ) is

    -- returns uninitialized OUT parameter

  begin

    if Report.Ident_Int( 0 ) = 1 then

      Report.Failed( "Nothing is something" );

      Unassigned := Imp_H.Scalar_To_Normalize'First;

    end if;

  end Bad_Code;

  procedure Check( V : CXH1001_0.Num; Message : String ) is

  begin

    if Imp_H.Default_For_Scalar_To_Normalize_Is_In_Range then

      if V /= Imp_H.Scalar_To_Normalize'Pos(

                                  Imp_H.Default_For_Scalar_To_Normalize) then

        Report.Failed(Message & ": Implicit initial value for object "

                       & "is not the predicted value");

      end if;

    elsif V'Valid and then V in

      Report.Failed(Message & ": Implicit initial value for object "

                     & "is a value of the type");

    end if;

  end Check;

begin  -- Main test procedure.

  Report.Test ("CXH1001", "Check that the configuration pragma " &

                          "Normalize_Scalars causes uninitialized scalar " &

                          "objects to be set to a predictable value. " &

                          "Check that multiple compilation units are " &

                          "affected.  Check for uninitialized scalar " &

                          "objects that are subcomponents of composite " &

                          "objects, unassigned out parameters, have been " &

                          "allocated without an initial value, and are " &

                          "stand alone." );

  CXH1001_0.Package_Check;

  if My_Object'Valid then

    Value := CXH1001_0.STN_2_Num ( My_Object ); -- My_Object not initialized

  end if;

  -- otherwise, we just leave Value uninitialized

  Check( Value, "main procedure variable" );

  Bad_Code( Parameter_Value );

  if Parameter_Value'Valid then

    Check( CXH1001_0.STN_2_Num ( Parameter_Value ), "Out parameter return" );

  end if;

  if S.Scalar'Valid then

    Check( CXH1001_0.STN_2_Num ( S.Scalar ), "Record component" );

  end if;

  CXH1001_0.CXH1001_1.Thingy.Check_Embedded_Values;

  Report.Result;

end CXH1001;