diff gcc/testsuite/ada/acats/tests/cxb/cxb5003.a @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/cxb/cxb5003.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,295 @@
+-- CXB5003.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 procedure To_Fortran converts the character elements
+--      of the String parameter Item into Character_Set elements of the
+--      Fortran_Character type parameter Target.  Check that the parameter 
+--      Last contains the index of the last element of parameter Target 
+--      that was assigned by To_Fortran.
+--
+--      Check that Constraint_Error is propagated by procedure To_Fortran
+--      when the length of String parameter Item exceeds the length of 
+--      Fortran_Character parameter Target.
+--
+--      Check that the procedure To_Ada converts the Character_Set
+--      elements of the Fortran_Character parameter Item into Character
+--      elements of the String parameter Target.  Check that the parameter
+--      Last contains the index of the last element of parameter Target 
+--      that was assigned by To_Ada.
+--
+--      Check that Constraint_Error is propagated by procedure To_Ada when
+--      the length of Fortran_Character parameter Item exceeds the length of 
+--      String parameter Target.
+--
+-- TEST DESCRIPTION:
+--      This test checks that the procedures To_Fortran and To_Ada produce
+--      the correct results, based on a variety of parameter input values.
+--      
+--      In the first series of subtests, the Out parameter results of 
+--      procedure To_Fortran are compared against expected results,
+--      which includes (in the parameter Last) the index in Target of the 
+--      last element assigned.  The situation where procedure To_Fortran
+--      raises Constraint_Error (when Item'Length exceeds Target'Length) 
+--      is also verified.
+--
+--      In the second series of subtests, the Out parameter results of 
+--      procedure To_Ada are verified, in a similar manner as is done for
+--      procedure To_Fortran.  The case of procedure To_Ada raising 
+--      Constraint_Error is also verified.
+--      
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.Fortran.Character_Set:
+--      ' ', 'a'..'j', 'A'..'D', '1'..'9', '-', '_', '$', '#', and '*'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      package Interfaces.Fortran.  If an implementation provides
+--      package Interfaces.Fortran, this test must compile, execute, and 
+--      report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      14 Mar 96   SAIC    Initial release for 2.1.
+--      10 Jun 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      27 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Ada.Exceptions;
+with Ada.Strings.Bounded;
+with Ada.Strings.Unbounded;
+with Interfaces.Fortran;                                      -- N/A => ERROR
+with Report;
+
+procedure CXB5003 is
+begin
+
+   Report.Test ("CXB5003", "Check that procedures To_Fortran and To_Ada " &
+                           "produce correct results");
+
+   Test_Block:
+   declare
+
+      package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(10);
+      package Unb renames Ada.Strings.Unbounded;
+
+      use Bnd, Unb;
+      use Interfaces.Fortran;
+      use Ada.Exceptions;
+
+      Fortran_Character_1     : Fortran_Character(1..1)  := " ";
+      Fortran_Character_5     : Fortran_Character(1..5)  := "     ";
+      Fortran_Character_10    : Fortran_Character(1..10) := "          ";
+      Fortran_Character_20    : Fortran_Character(1..20) := 
+                                  "                    ";
+      TC_Fortran_Character_1  : Fortran_Character(1..1)  := "A";
+      TC_Fortran_Character_5  : Fortran_Character(1..5)  := "ab*de";
+      TC_Fortran_Character_10 : Fortran_Character(1..10) := "$1a2b3C4D5";
+      TC_Fortran_Character_20 : Fortran_Character(1..20) := 
+                                  "1234-ABCD_6789#fghij";
+
+      Bnd_String              : Bnd.Bounded_String   :=
+                                  Bnd.To_Bounded_String("          ");
+      TC_Bnd_String           : Bounded_String       :=
+                                  To_Bounded_String("$1a2b3C4D5");
+
+      Unb_String              : Unb.Unbounded_String :=
+                                  Unb.To_Unbounded_String("     ");
+      TC_Unb_String           : Unbounded_String     :=
+                                  To_Unbounded_String("ab*de");
+
+      String_1                : String(1..1)   := " ";
+      String_5                : String(1..5)   := "     ";
+      String_10               : String(1..10)  := "          ";
+      String_20               : String(1..20)  := "                    ";
+      TC_String_1             : String(1..1)   := "A";
+      TC_String_20            : String(1..20)  := "1234-ABCD_6789#fghij";
+
+      TC_Fortran_Character    : constant Fortran_Character := ""; 
+      TC_String               : constant String            := ""; 
+      TC_Natural              : Natural                    := 0;
+
+
+   begin
+
+      -- Check that the procedure To_Fortran converts the character elements
+      -- of the String parameter Item into Character_Set elements of the 
+      -- Fortran_Character type parameter Target.  
+      -- Check that the parameter Last contains the index of the last element
+      -- of parameter Target that was assigned by To_Fortran.
+
+      To_Fortran(Item   => TC_String_1,
+                 Target => Fortran_Character_1,
+                 Last   => TC_Natural);
+
+      if Fortran_Character_1 /= TC_Fortran_Character_1        or
+         TC_Natural          /= TC_Fortran_Character_1'Length 
+      then
+         Report.Failed("Incorrect result from procedure To_Fortran - 1");
+      end if;
+
+      To_Fortran(To_String(TC_Unb_String),
+                 Target => Fortran_Character_5,
+                 Last   => TC_Natural);
+
+      if Fortran_Character_5 /= TC_Fortran_Character_5        or
+         TC_Natural          /= TC_Fortran_Character_5'Length 
+      then
+         Report.Failed("Incorrect result from procedure To_Fortran - 2");
+      end if;
+
+      To_Fortran(To_String(TC_Bnd_String),
+                 Fortran_Character_10,
+                 Last   => TC_Natural);
+
+      if Fortran_Character_10 /= TC_Fortran_Character_10        or
+         TC_Natural           /= TC_Fortran_Character_10'Length
+      then
+         Report.Failed("Incorrect result from procedure To_Fortran - 3");
+      end if;
+
+      To_Fortran(TC_String_20, Fortran_Character_20, TC_Natural);
+
+      if Fortran_Character_20 /= TC_Fortran_Character_20        or
+         TC_Natural           /= TC_Fortran_Character_20'Length 
+      then
+         Report.Failed("Incorrect result from procedure To_Fortran - 4");
+      end if;
+
+      To_Fortran(Item   => TC_String,     -- null string
+                 Target => Fortran_Character_1,
+                 Last   => TC_Natural);
+
+      if TC_Natural /= 0 then
+         Report.Failed("Incorrect result from procedure To_Fortran, value "  &
+                       "returned in parameter Last should be zero, since " &
+                       "parameter Item is null array");
+      end if;
+
+
+      -- Check that Constraint_Error is propagated by procedure To_Fortran
+      -- when the length of String parameter Item exceeds the length of 
+      -- Fortran_Character parameter Target.
+
+      begin
+
+         To_Fortran(Item   => TC_String_20,
+                    Target => Fortran_Character_10,
+                    Last   => TC_Natural);
+         Report.Failed("Constraint_Error not raised by procedure " &
+                       "To_Fortran when Item'Length exceeds Target'Length");
+      exception
+         when Constraint_Error   => null;  -- OK, expected exception.
+         when The_Error : others =>
+            Report.Failed("The following exception was raised by procedure " &
+                          "To_Fortran when Item'Length exceeds "             &
+                          "Target'Length: " & Exception_Name(The_Error));
+      end;
+
+
+      -- Check that the procedure To_Ada converts the Character_Set 
+      -- elements of the Fortran_Character parameter Item into Character
+      -- elements of the String parameter Target.  
+      -- Check that the parameter Last contains the index of the last 
+      -- element of parameter Target that was assigned by To_Ada.
+
+      To_Ada(Item   => TC_Fortran_Character_1,
+             Target => String_1,
+             Last   => TC_Natural);
+
+      if String_1   /= TC_String_1        or
+         TC_Natural /= TC_String_1'Length 
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 1");
+      end if;
+
+      To_Ada(TC_Fortran_Character_5,
+             Target => String_5,
+             Last   => TC_Natural);
+
+      if String_5   /= To_String(TC_Unb_String) or
+         TC_Natural /= Length(TC_Unb_String)    
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 2");
+      end if;
+
+      To_Ada(TC_Fortran_Character_10,
+             String_10,
+             Last   => TC_Natural);
+
+      if String_10   /= To_String(TC_Bnd_String) or
+         TC_Natural  /= Length(TC_Bnd_String)   
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 3");
+      end if;
+
+      To_Ada(TC_Fortran_Character_20, String_20, TC_Natural);
+
+      if String_20   /= TC_String_20        or
+         TC_Natural  /= TC_String_20'Length 
+      then
+         Report.Failed("Incorrect result from procedure To_Ada - 4");
+      end if;
+
+      To_Ada(Item   => TC_Fortran_Character,  -- null array.
+             Target => String_20,
+             Last   => TC_Natural);
+
+      if TC_Natural /= 0 then
+         Report.Failed("Incorrect result from procedure To_Ada, value "    &
+                       "returned in parameter Last should be zero, since " &
+                       "parameter Item is null array");
+      end if;
+
+
+      -- Check that Constraint_Error is propagated by procedure To_Ada 
+      -- when the length of Fortran_Character parameter Item exceeds the 
+      -- length of String parameter Target.
+
+      begin
+
+         To_Ada(Item   => TC_Fortran_Character_10,
+                Target => String_5,
+                Last   => TC_Natural);
+         Report.Failed("Constraint_Error not raised by procedure To_Ada " &
+                       "when Item'Length exceeds Target'Length");
+      exception
+         when Constraint_Error   => null;  -- OK, expected exception.
+         when The_Error : others =>
+            Report.Failed("Incorrect exception raised by procedure To_Ada " &
+                          "when Item'Length exceeds Target'Length");
+      end;
+
+
+   exception
+      when The_Error : others => 
+         Report.Failed("The following exception was raised in the " &
+                       "Test_Block: " & Exception_Name(The_Error));
+   end Test_Block;
+
+   Report.Result;
+
+end CXB5003;