Subversion Repositories openrisc_me

-- TCTouch.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.

--*

--

-- FOUNDATION DESCRIPTION:

--      The tools in this foundation are not peculiar to any particular

--      aspect of the language, but simplify the test writing and reading

--      process.  Assert and Assert_Not are used to reduce the textual

--      overhead of the test-that-this-condition-is-(not)-true paradigm.

--      Touch and Validate are used to simplify tracing an expected path

--      of execution.

--      A tag comment of the form:

--

--      TCTouch.Touch( 'A' ); ----------------------------------------- A

--

--      is recommended to improve readability of this feature.

--

--      Report.Test must be called before any of the procedures in this

--      package with the exception of Touch.

--      The usage paradigm is to call Touch in locations in the test where you

--      want a trace of execution.  Each call to Touch should have a unique

--      character associated with it.  At each place where a check can

--      reasonably be performed to determine correct execution of a

--      sub-test, a call to Validate should be made.  The first parameter

--      passed to Validate is the expected string of characters produced by

--      call(s) to Touch in the subtest just executed.  The second parameter

--      is the message to pass to Report.Failed if the expected sequence was

--      not executed.

--

--      Validate should always be called after calls to Touch before a test

--      completes.

--

--      In the event that calls may have been made to Touch that are not

--      intended to be recorded, or, the failure of a previous subtest may

--      leave Touch calls "Unvalidated", the procedure Flush will reset the

--      tracker to the "empty" state.  Flush does not make any calls to

--      Report.

--

--      Calls to Assert and Assert_Not are to replace the idiom:

--

--         if BadCondition then  -- or if not PositiveTest then

--           Report.Failed(Message);

--         end if;

--

--      with:

--

--         Assert_Not( BadCondition, Message ); -- or

--         Assert( PositiveTest, Message );

--

--      Implementation_Check is for use with tests that cross the boundary

--      between the core and the Special Needs Annexes.  There are several

--      instances where language in the core becomes enforceable only when

--      a Special Needs Annex is supported.  Implementation_Check should be

--      called in place of Report.Failed in these cases; it examines the

--      constants in Impdef that indicate if the particular Special Needs

--      Annex is being validated with this validation; and acts accordingly.

--

--      The constant Foundation_ID contains the internal change version

--      for this software.

--

-- ERROR CONDITIONS:

--

--      It is an error to perform more than Max_Touch_Count (80) calls to

--      Touch without a subsequent call to Validate.  To do so will cause

--      a false test failure.

--

-- CHANGE HISTORY:

--     02 JUN 94   SAIC    Initial version

--     27 OCT 94   SAIC    Revised version

--     07 AUG 95   SAIC    Added Implementation_Check

--     07 FEB 96   SAIC    Changed to match new Impdef for 2.1

--     16 MAR 00   RLB     Changed foundation id to reflect test suite version.

--     22 MAR 01   RLB     Changed foundation id to reflect test suite version.

--     29 MAR 02   RLB     Changed foundation id to reflect test suite version.

--

--!

package TCTouch is

  Foundation_ID   : constant String := "TCTouch ACATS 2.5";

  Max_Touch_Count : constant        := 80;

  procedure Assert    ( SB_True  : Boolean; Message : String );

  procedure Assert_Not( SB_False : Boolean; Message : String );

  procedure Touch   ( A_Tag   : Character );

  procedure Validate( Expected: String;

                      Message : String;

                      Order_Meaningful : Boolean := True );

  procedure Flush;

  type Special_Needs_Annexes is ( Annex_C, Annex_D, Annex_E,

                                  Annex_F, Annex_G, Annex_H );

  procedure Implementation_Check( Message : in String;

                                  Annex   : in Special_Needs_Annexes

                                          := Annex_C );

    -- If Impdef.Validating_Annex_<Annex> is true, will call Report.Failed

    -- otherwise will call Report.Not_Applicable.  This is to allow tests

    -- which are driven by wording in the core of the language, yet have

    -- their functionality dictated by the Special Needs Annexes to perform

    -- dual purpose.

    -- The default of Annex_C for the Annex parameter is to support early

    -- tests written with the assumption that Implementation_Check was

    -- expressly for use with the Systems Programming Annex.

end TCTouch;

with Report;

with Impdef;

package body TCTouch is

  procedure Assert( SB_True : Boolean; Message : String ) is

  begin

    if not SB_True then

      Report.Failed( "Assertion failed: " & Message );

    end if;

  end Assert;

  procedure Assert_Not( SB_False : Boolean; Message : String ) is

  begin

    if SB_False then

      Report.Failed( "Assertion failed: " & Message );

    end if;

  end Assert_Not;

  Collection : String(1..Max_Touch_Count);

  Finger     : Natural := 0;

  procedure Touch ( A_Tag : Character ) is

  begin

    Finger := Finger+1;

    Collection(Finger) := A_Tag;

  exception

    when Constraint_Error =>

      Report.Failed("Trace Overflow: " & Collection);

      Finger := 0;

  end Touch;

  procedure Sort_String( S: in out String ) is

  -- algorithm from Booch Components Page 472

    No_Swaps : Boolean;

    procedure Swap(C1, C2: in out Character) is

      T: Character := C1;

    begin  C1 := C2; C2 := T; end Swap;

  begin

    for OI in S'First+1..S'Last loop

      No_Swaps := True;

      for II in reverse OI..S'Last loop

        if S(II) < S(II-1) then

          Swap(S(II),S(II-1));

          No_Swaps := False;

        end if;

      end loop;

      exit when No_Swaps;

    end loop;

  end Sort_String;

  procedure Validate( Expected: String;

                      Message : String;

                      Order_Meaningful : Boolean := True) is

    Want : String(1..Expected'Length) := Expected;

  begin

    if not Order_Meaningful then

      Sort_String( Want );

      Sort_String( Collection(1..Finger) );

    end if;

    if Collection(1..Finger) /= Want then

      Report.Failed( Message & " Expecting: " & Want

                             & " Got: " & Collection(1..Finger) );

    end if;

    Finger := 0;

  end Validate;

  procedure Flush is

  begin

    Finger := 0;

  end Flush;

  procedure Implementation_Check( Message : in String;

                                  Annex   : in Special_Needs_Annexes

                                          := Annex_C ) is

                                          -- default to cover some legacy

  -- USAGE DISCIPLINE:

  --   Implementation_Check is designed to be used in tests that have

  --   interdependency on one of the Special Needs Annexes, yet are _really_

  --   tests based in the core language.  There will be instances where the

  --   execution of a test would be failing in the light of the requirements

  --   of the annex, yet from the point of view of the core language without

  --   the additional requirements of the annex, the test does not apply.

  --   In these cases, rather than issuing a call to Report.Failed, calling

  --   TCTouch.Implementation_Check will check that sensitivity, and if

  --   the implementation is attempting to validate against the specific

  --   annex, Report.Failed will be called, otherwise, Report.Not_Applicable

  --   will be called.

  begin

    case Annex is

      when Annex_C =>

        if ImpDef.Validating_Annex_C then

          Report.Failed( Message );

        else

          Report.Not_Applicable( Message & " Annex C not supported" );

       end if;

      when Annex_D =>

        if ImpDef.Validating_Annex_D then

          Report.Failed( Message );

        else

          Report.Not_Applicable( Message & " Annex D not supported" );

       end if;

      when Annex_E =>

        if ImpDef.Validating_Annex_E then

          Report.Failed( Message );

        else

          Report.Not_Applicable( Message & " Annex E not supported" );

       end if;

      when Annex_F =>

        if ImpDef.Validating_Annex_F then

          Report.Failed( Message );

        else

          Report.Not_Applicable( Message & " Annex F not supported" );

       end if;

      when Annex_G =>

        if ImpDef.Validating_Annex_G then

          Report.Failed( Message );

        else

          Report.Not_Applicable( Message & " Annex G not supported" );

       end if;

      when Annex_H =>

        if ImpDef.Validating_Annex_H then

          Report.Failed( Message );

        else

          Report.Not_Applicable( Message & " Annex H not supported" );

       end if;

    end case;

 end Implementation_Check;

end TCTouch;