cxf3a08.a

来自「linux下编程用 编译软件」· A 代码 · 共 290 行

-- CXF3A08.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 that the version of Ada.Text_IO.Editing.Put with an out 
--      String parameter propagates Layout_Error if the edited output string 
--      result of Put exceeds the length of the out String parameter.
--      
-- TEST DESCRIPTION:
--      This test is structured using tables of data, consisting of
--      numerical values, picture strings, and expected image
--      result strings.  These data tables are found in package FXF3A00.
--      
--      This test examines the case of the out string parameter to Procedure
--      Put being insufficiently long to hold the entire edited output
--      string result of the procedure.  In this case, Layout_Error is to be
--      raised.  Test failure results if Layout_Error is not raised, or if an
--      exception other than Layout_Error is raised.
--      
--      A number of data combinations are examined, using instantiations 
--      of Package Decimal_Output with different decimal data types and 
--      both default and non-default parameters as generic actual parameters.
--      In addition, calls to Procedure Put are performed using default 
--      parameters, non-default parameters, and non-default parameters that 
--      override the generic actual parameters provided at the time of 
--      instantiation of Decimal_Output.
--      
-- TEST FILES:
--      The following files comprise this test:
--
--         FXF3A00.A   (foundation code)
--      => CXF3A08.A
--
--       
-- CHANGE HISTORY:
--      31 JAN 95   SAIC    Initial prerelease version.
--
--!

with FXF3A00;
with Ada.Text_IO.Editing;
with Report;

procedure CXF3A08 is
begin

   Report.Test ("CXF3A08", "Check that the version of "                &
                           "Ada.Text_IO.Editing.Put with an out "      &
                           "String parameter propagates Layout_Error " &
                           "if the output string exceeds the length "  &
                           "of the out String parameter");

   Test_Block:
   declare

      use Ada.Text_IO;

      -- Instantiate the Decimal_Output generic package for two
      -- different decimal data types.
                                   -- Uses decimal type with delta 0.01 and
      package Pack_2DP is          -- non-default generic actual parameters.
        new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_2DP,
                                   Default_Currency   => "$",
                                   Default_Fill       => '*',
                                   Default_Separator  => ',',
                                   Default_Radix_Mark => '.');

      package Pack_NDP is          -- Uses decimal type with delta 1.0.
        new Editing.Decimal_Output(FXF3A00.Decimal_Type_NDP);

      TC_Picture       : Editing.Picture;
      TC_Start_Loop    : Integer := 0;
      TC_End_Loop      : Integer := 0;
      TC_Offset        : Integer := 0;

      TC_Short_String  : String(1..4);   -- Shorter than the shortest edited
                                         -- output string result.

   begin

      -- Examine cases where the out string parameter is shorter than 
      -- the length of the edited output result.  Use the instantiation of 
      -- Decimal_Output specific to data with two decimal places.

      TC_Start_Loop := 1;
      TC_End_Loop   := FXF3A00.Number_of_2DP_Items -              -- 10
                       FXF3A00.Number_Of_Foreign_Strings;

      for i in TC_Start_Loop..TC_End_Loop loop                    -- 1..10

         -- Create the picture object from the picture string.

         TC_Picture := 
           Editing.To_Picture(Pic_String => FXF3A00.Valid_Strings(i).all,
                              Blank_When_Zero => False);

         -- The out parameter string provided in the call to Put is 
         -- shorter than the edited output result of the procedure.  
         -- This will result in a Layout_Error being raised and handled.
         -- Test failure results from no exception being raised, or from
         -- the wrong exception being raised.

         begin

            -- Use the instantiation of Decimal_Output specific to decimal
            -- data with two decimal places, as well as non-default 
            -- parameters and named parameter association.

            Pack_2DP.Put(To         => TC_Short_String,
                         Item       => FXF3A00.Data_With_2DP(i),
                         Pic        => TC_Picture,
                         Currency   => "$",
                         Fill       => '*',
                         Separator  => ',',
                         Radix_Mark => '.');

            -- Test failure if exception not raised.

            Report.Failed
              ("Layout_Error not raised, decimal data with two decimal " &
               "places, loop #" & Integer'Image(i));

         exception
            when Layout_Error => null;  -- OK, expected exception.
            when others       =>
               Report.Failed
                 ("Incorrect exception raised, Layout_Error expected, " &
                  "decimal data with two decimal places, loop #"        &
                  Integer'Image(i));
         end;
      end loop;


      -- Perform similar evaluations as above, but use the instantiation
      -- of Decimal_Output specific to decimal data with no decimal places.

      TC_Start_Loop := TC_End_Loop + 1;                           -- 11
      TC_End_Loop   := TC_Start_Loop +                            -- 22
                       FXF3A00.Number_of_NDP_Items - 1;               
      TC_Offset     := FXF3A00.Number_of_Foreign_Strings;         -- 10
      -- This offset is required due to the arrangement of data within the
      -- tables found in FXF3A00.

      for i in TC_Start_Loop..TC_End_Loop loop                    -- 11..22

         -- Create the picture object from the picture string.

         TC_Picture := Editing.To_Picture(FXF3A00.Valid_Strings(i).all);

         begin

            -- Use the instantiation of Decimal_Output specific to decimal
            -- data with no decimal places, as well as default parameters
            -- and positional parameter association.

            Pack_NDP.Put(TC_Short_String,
                         FXF3A00.Data_With_NDP(i-TC_Offset),
                         TC_Picture);

            -- Test failure if exception not raised.

            Report.Failed
              ("Layout_Error not raised, decimal data with no decimal " &
               "places, loop #" & Integer'Image(i));

         exception
            when Layout_Error => null;  -- OK, expected exception.
            when others       =>
               Report.Failed
                 ("Incorrect exception raised, Layout_Error expected, " &
                  "decimal data with no decimal places, loop #"         &
                  Integer'Image(i));
         end;

      end loop;


      -- Check that Layout_Error is raised by Put resulting from an
      -- instantiation of Decimal_Output specific to foreign currency
      -- representations. 
      -- Note: Both of the following evaluation sets use decimal data with 
      --       two decimal places.

      declare

         package Pack_FF is 
           new Editing.Decimal_Output(Num => FXF3A00.Decimal_Type_2DP,
                                      Default_Currency   => "FF",
                                      Default_Fill       => '*',
                                      Default_Separator  => '.',
                                      Default_Radix_Mark => ',');

      begin

         TC_Offset := FXF3A00.Number_Of_2DP_Items -                 -- 10
                      FXF3A00.Number_Of_Foreign_Strings;

         for i in 1..FXF3A00.Number_Of_FF_Strings loop              -- 1..4
            begin

               -- Create the picture object from the picture string.
               TC_Picture := 
                 Editing.To_Picture(FXF3A00.Foreign_Strings(i).all);

               Pack_FF.Put(To   => TC_Short_String,
                           Item => FXF3A00.Data_With_2DP(i+TC_Offset),
                           Pic  => TC_Picture);

               Report.Failed("Layout_Error was not raised by Put from "  &
                             "an instantiation of Decimal_Output using " &
                             "non-default parameters specific to FF "    &
                             "currency, loop #" & Integer'Image(i));

            exception
               when Layout_Error => null;  -- OK, expected exception.
               when others       =>
                  Report.Failed("Incorrect exception raised by Put from "   &
                                "an instantiation of Decimal_Output using " &
                                "non-default parameters specific to FF "    &
                                "currency, loop #" & Integer'Image(i));
            end;
         end loop;


         -- These evaluations use a version of Put resulting from a 
         -- non-default instantiation of Decimal_Output, but which has 
         -- specific foreign currency parameters provided in the call that
         -- override the generic actual parameters provided at instantiation.

         TC_Offset := TC_Offset + FXF3A00.Number_Of_FF_Strings;      -- 14

         for i in 1..FXF3A00.Number_Of_DM_Strings loop               -- 1..5
            begin
               TC_Picture := 
                 Editing.To_Picture(FXF3A00.Foreign_Strings
                                      (i+FXF3A00.Number_Of_FF_Strings).all);

               Pack_2DP.Put(To         => TC_Short_String,
                            Item       => FXF3A00.Data_With_2DP(i+TC_Offset),
                            Pic        => TC_Picture,
                            Currency   => "DM",
                            Fill       => '*',
                            Separator  => ',',
                            Radix_Mark => '.');

               Report.Failed("Layout_Error was not raised by Put using " &
                             "non-default parameters specific to DM "    &
                             "currency, loop #" & Integer'Image(i));

            exception
               when Layout_Error => null;  -- OK, expected exception.
               when others       =>
                  Report.Failed("Incorrect exception raised by Put using " &
                                "non-default parameters specific to DM "   &
                                "currency, loop #" & Integer'Image(i));
            end;
         end loop;

      end;

   exception
      when others => Report.Failed("Exception raised in Test_Block");
   end Test_Block;

   Report.Result;

end CXF3A08;