OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxa/] [cxaf001.a] - Diff between revs 149 and 154

Go to most recent revision | Only display areas with differences | Details | Blame | View Log

Rev 149 Rev 154
-- CXAF001.A
-- CXAF001.A
--
--
--                             Grant of Unlimited Rights
--                             Grant of Unlimited Rights
--
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     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
--     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 in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
--     this public release, the Government intends to confer upon all
--     this public release, the Government intends to confer upon all
--     recipients unlimited rights  equal to those held by the Government.
--     recipients unlimited rights  equal to those held by the Government.
--     These rights include rights to use, duplicate, release or disclose the
--     These rights include rights to use, duplicate, release or disclose the
--     released technical data and computer software in whole or in part, in
--     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
--     any manner and for any purpose whatsoever, and to have or permit others
--     to do so.
--     to do so.
--
--
--                                    DISCLAIMER
--                                    DISCLAIMER
--
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--*
--
--
-- OBJECTIVE:
-- OBJECTIVE:
--      Check that an implementation supports the functionality defined
--      Check that an implementation supports the functionality defined
--      in Package Ada.Command_Line.
--      in Package Ada.Command_Line.
--
--
-- TEST DESCRIPTION:
-- TEST DESCRIPTION:
--      This test verifies that an implementation supports the subprograms
--      This test verifies that an implementation supports the subprograms
--      contained in package Ada.Command_Line.  Each of the subprograms
--      contained in package Ada.Command_Line.  Each of the subprograms
--      is exercised in a general sense, to ensure that it is available,
--      is exercised in a general sense, to ensure that it is available,
--      and that it provides the prescribed results in a known test
--      and that it provides the prescribed results in a known test
--      environment.  Function Argument_Count must return zero, or the
--      environment.  Function Argument_Count must return zero, or the
--      number of arguments passed to the program calling it.  Function
--      number of arguments passed to the program calling it.  Function
--      Argument is called with a parameter value one greater than the
--      Argument is called with a parameter value one greater than the
--      actual number of arguments passed to the executing program, which
--      actual number of arguments passed to the executing program, which
--      must result in Constraint_Error being raised.  Function Command_Name
--      must result in Constraint_Error being raised.  Function Command_Name
--      should return the name of the executing program that called it
--      should return the name of the executing program that called it
--      (specifically, this test name).  Function Set_Exit_Status is called
--      (specifically, this test name).  Function Set_Exit_Status is called
--      with two different parameter values, the constants Failure and
--      with two different parameter values, the constants Failure and
--      Success defined in package Ada.Command_Line.
--      Success defined in package Ada.Command_Line.
--
--
--      The setting of the variable TC_Verbose allows for some additional
--      The setting of the variable TC_Verbose allows for some additional
--      output to be displayed during the running of the test as an aid in
--      output to be displayed during the running of the test as an aid in
--      tracing the processing flow of the test.
--      tracing the processing flow of the test.
--
--
-- APPLICABILITY CRITERIA:
-- APPLICABILITY CRITERIA:
--      This test is applicable to implementations that support the
--      This test is applicable to implementations that support the
--      declaration of package Command_Line as defined in the Ada Reference
--      declaration of package Command_Line as defined in the Ada Reference
--      manual.
--      manual.
--      An alternative declaration is allowed for package Command_Line if
--      An alternative declaration is allowed for package Command_Line if
--      different functionality is appropriate for the external execution
--      different functionality is appropriate for the external execution
--      environment.
--      environment.
--
--
--
--
-- CHANGE HISTORY:
-- CHANGE HISTORY:
--      10 Jul 95   SAIC    Initial prerelease version.
--      10 Jul 95   SAIC    Initial prerelease version.
--      02 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
--      02 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
--      05 AUG 98   EDS     Allow Null string result to be returned from
--      05 AUG 98   EDS     Allow Null string result to be returned from
--                          Function Command
--                          Function Command
--!
--!
with Ada.Command_Line;
with Ada.Command_Line;
with Ada.Exceptions;
with Ada.Exceptions;
with Report;
with Report;
procedure CXAF001 is
procedure CXAF001 is
begin
begin
   Report.Test ("CXAF001", "Check that an implementation supports the " &
   Report.Test ("CXAF001", "Check that an implementation supports the " &
                           "functionality defined in Package "          &
                           "functionality defined in Package "          &
                           "Ada.Command_Line");
                           "Ada.Command_Line");
   Test_Block:
   Test_Block:
   declare
   declare
      use Ada.Exceptions;
      use Ada.Exceptions;
      type String_Access is access all String;
      type String_Access is access all String;
      TC_Verbose           : Boolean := False;
      TC_Verbose           : Boolean := False;
      Number_Of_Arguments  : Natural := Natural'Last;
      Number_Of_Arguments  : Natural := Natural'Last;
      Name_Of_Command      : String_Access;
      Name_Of_Command      : String_Access;
   begin
   begin
      -- Check the result of function Argument_Count.
      -- Check the result of function Argument_Count.
      -- Note: If the external environment does not support passing arguments
      -- Note: If the external environment does not support passing arguments
      --       to the program invoking the function, the function result
      --       to the program invoking the function, the function result
      --       will be zero.
      --       will be zero.
      Number_Of_Arguments := Ada.Command_Line.Argument_Count;
      Number_Of_Arguments := Ada.Command_Line.Argument_Count;
      if Number_Of_Arguments = Natural'Last then
      if Number_Of_Arguments = Natural'Last then
         Report.Failed("Argument_Count did not provide a return result");
         Report.Failed("Argument_Count did not provide a return result");
      end if;
      end if;
      if TC_Verbose then
      if TC_Verbose then
         Report.Comment
         Report.Comment
           ("Argument_Count = " & Integer'Image(Number_Of_Arguments));
           ("Argument_Count = " & Integer'Image(Number_Of_Arguments));
      end if;
      end if;
      -- Check that the result of Function Argument is Constraint_Error
      -- Check that the result of Function Argument is Constraint_Error
      -- when the Number argument is outside the range of 1..Argument_Count.
      -- when the Number argument is outside the range of 1..Argument_Count.
      Test_Function_Argument_1 :
      Test_Function_Argument_1 :
      begin
      begin
         declare
         declare
            -- Define a value that will be outside the range of
            -- Define a value that will be outside the range of
            -- 1..Argument_Count.
            -- 1..Argument_Count.
            -- Note: If the external execution environment does not support
            -- Note: If the external execution environment does not support
            --       passing arguments to a program, then Argument(N) for
            --       passing arguments to a program, then Argument(N) for
            --       any N will raise Constraint_Error, since
            --       any N will raise Constraint_Error, since
            --       Argument_Count = 0;
            --       Argument_Count = 0;
            Arguments_Plus_One : Positive :=
            Arguments_Plus_One : Positive :=
              Ada.Command_Line.Argument_Count + 1;
              Ada.Command_Line.Argument_Count + 1;
            -- Using the above value in a call to Argument must result in
            -- Using the above value in a call to Argument must result in
            -- the raising of Constraint_Error.
            -- the raising of Constraint_Error.
            Argument_String    : constant String :=
            Argument_String    : constant String :=
              Ada.Command_Line.Argument(Arguments_Plus_One);
              Ada.Command_Line.Argument(Arguments_Plus_One);
         begin
         begin
            Report.Failed("Constraint_Error not raised by Function "  &
            Report.Failed("Constraint_Error not raised by Function "  &
                          "Argument when provided a Number argument " &
                          "Argument when provided a Number argument " &
                          "out of range");
                          "out of range");
         end;
         end;
      exception
      exception
         when Constraint_Error => null;  -- OK, expected exception.
         when Constraint_Error => null;  -- OK, expected exception.
            if TC_Verbose then
            if TC_Verbose then
              Report.Comment ("Argument_Count raised Constraint_Error");
              Report.Comment ("Argument_Count raised Constraint_Error");
            end if;
            end if;
         when others =>
         when others =>
            Report.Failed ("Unexpected exception raised by Argument " &
            Report.Failed ("Unexpected exception raised by Argument " &
                           "in Test_Function_Argument_1 block");
                           "in Test_Function_Argument_1 block");
      end Test_Function_Argument_1;
      end Test_Function_Argument_1;
      -- Check that Function Argument returns a string result.
      -- Check that Function Argument returns a string result.
      Test_Function_Argument_2 :
      Test_Function_Argument_2 :
      begin
      begin
         if Ada.Command_Line.Argument_Count > 0 then
         if Ada.Command_Line.Argument_Count > 0 then
            Report.Comment
            Report.Comment
              ("Last argument is: " &
              ("Last argument is: " &
               Ada.Command_Line.Argument(Ada.Command_Line.Argument_Count));
               Ada.Command_Line.Argument(Ada.Command_Line.Argument_Count));
         elsif TC_Verbose then
         elsif TC_Verbose then
            Report.Comment("Argument_Count is zero, no test of Function " &
            Report.Comment("Argument_Count is zero, no test of Function " &
                           "Argument for string result");
                           "Argument for string result");
         end if;
         end if;
      exception
      exception
         when others =>
         when others =>
            Report.Failed ("Unexpected exception raised by Argument " &
            Report.Failed ("Unexpected exception raised by Argument " &
                           "in Test_Function_Argument_2 block");
                           "in Test_Function_Argument_2 block");
      end Test_Function_Argument_2;
      end Test_Function_Argument_2;
      -- Check the result of Function Command_Name.
      -- Check the result of Function Command_Name.
      Name_Of_Command := new String'(Ada.Command_Line.Command_Name);
      Name_Of_Command := new String'(Ada.Command_Line.Command_Name);
      if Name_Of_Command = null  then
      if Name_Of_Command = null  then
         Report.Failed("Null string pointer returned from Function Command");
         Report.Failed("Null string pointer returned from Function Command");
      elsif Name_Of_Command.all = "" then
      elsif Name_Of_Command.all = "" then
         Report.Comment("Null string result returned from Function Command");
         Report.Comment("Null string result returned from Function Command");
      elsif TC_Verbose then
      elsif TC_Verbose then
         Report.Comment("Invoking command is " & Name_Of_Command.all);
         Report.Comment("Invoking command is " & Name_Of_Command.all);
      end if;
      end if;
      -- Check that procedure Set_Exit_Status is available.
      -- Check that procedure Set_Exit_Status is available.
      -- Note: If the external execution environment does not support
      -- Note: If the external execution environment does not support
      --       returning an exit value from a program, then Set_Exit_Status
      --       returning an exit value from a program, then Set_Exit_Status
      --       does nothing.
      --       does nothing.
      Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure);
      Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure);
      if TC_Verbose then
      if TC_Verbose then
         Report.Comment("Exit status set to Failure");
         Report.Comment("Exit status set to Failure");
      end if;
      end if;
      Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success);
      Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success);
      if TC_Verbose then
      if TC_Verbose then
         Report.Comment("Exit status set to Success");
         Report.Comment("Exit status set to Success");
      end if;
      end if;
   exception
   exception
      when The_Error : others =>
      when The_Error : others =>
         Report.Failed ("The following exception was raised in the " &
         Report.Failed ("The following exception was raised in the " &
                        "Test_Block: " & Exception_Name(The_Error));
                        "Test_Block: " & Exception_Name(The_Error));
   end Test_Block;
   end Test_Block;
   Report.Result;
   Report.Result;
end CXAF001;
end CXAF001;
 
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.