--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/cxb/cxb3014.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,254 @@
+-- CXB3014.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 Function Value with Pointer and Element 
+--      parameters will return an Element_Array result of correct size 
+--      and content (up to and including the first "terminator" Element). 
+--
+--      Check that the Function Value with Pointer and Length parameters 
+--      will return an Element_Array result of appropriate size and content
+--      (the first Length elements pointed to by the parameter Ref).
+--
+--      Check that both versions of Function Value will propagate 
+--      Interfaces.C.Strings.Dereference_Error when the value of
+--      the Ref pointer parameter is null.
+--
+-- TEST DESCRIPTION:
+--      This test tests that both versions of Function Value from the 
+--      generic package Interfaces.C.Pointers are available and produce
+--      correct results.  The generic package is instantiated with size_t,
+--      char, char_array, and nul as actual parameters, and subtests are
+--      performed on each of the Value functions resulting from this
+--      instantiation.
+--      For both function versions, a test is performed where a portion of
+--      a char_array is to be returned as the function result.  Likewise,
+--      a test is performed where each version of the function returns the
+--      entire char_array referenced by the in parameter Ref.
+--      Finally, both versions of Function Value are called with a null
+--      pointer reference, to ensure that Dereference_Error is raised in
+--      this case.
+--      
+--      This test assumes that the following characters are all included
+--      in the implementation defined type Interfaces.C.char:
+--      ' ', 'a'..'z', and 'A'..'Z'.
+--      
+-- APPLICABILITY CRITERIA: 
+--      This test is applicable to all implementations that provide 
+--      packages Interfaces.C.Strings and Interfaces.C.Pointers.  If an 
+--      implementation provides packages Interfaces.C.Strings and 
+--      Interfaces.C.Pointers, this test must compile, execute, and 
+--      report "PASSED".
+--
+--       
+-- CHANGE HISTORY:
+--      19 Oct 95   SAIC    Initial prerelease version.
+--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
+--      23 Oct 96   SAIC    Incorporated reviewer comments.
+--
+--!
+
+with Report;
+with Interfaces.C.Strings;                                    -- N/A => ERROR
+with Interfaces.C.Pointers;                                   -- N/A => ERROR
+
+procedure CXB3014 is
+
+begin
+
+   Report.Test ("CXB3014", "Check that versions of the Value function "  &
+                           "from package Interfaces.C.Pointers produce " &
+                           "correct results");
+
+   Test_Block:
+   declare
+
+      use type Interfaces.C.char, Interfaces.C.size_t;
+
+      Char_a : constant Interfaces.C.char := 'a';
+      Char_j : constant Interfaces.C.char := 'j';
+      Char_z : constant Interfaces.C.char := 'z';
+
+      subtype Lower_Case_chars is Interfaces.C.char range Char_a..Char_z;
+      subtype Char_Range       is Interfaces.C.size_t range 0..26;
+
+      Local_nul       : aliased Interfaces.C.char := Interfaces.C.nul;
+      TC_Array_Size   : Interfaces.C.size_t := 20;
+
+      TC_String_1     : constant String := "abcdefghij";
+      TC_String_2     : constant String := "abcdefghijklmnopqrstuvwxyz";
+      TC_String_3     : constant String := "abcdefghijklmnopqrst";
+      TC_String_4     : constant String := "abcdefghijklmnopqrstuvwxyz";
+      TC_Blank_String : constant String := "                          ";
+
+      TC_Char_Array   : Interfaces.C.char_array(Char_Range) :=
+                          Interfaces.C.To_C(TC_String_2, True);
+
+      TC_Char_Array_1 : Interfaces.C.char_array(0..9);
+      TC_Char_Array_2 : Interfaces.C.char_array(Char_Range);
+      TC_Char_Array_3 : Interfaces.C.char_array(0..TC_Array_Size-1);
+      TC_Char_Array_4 : Interfaces.C.char_array(Char_Range);
+
+      package Char_Pointers is new 
+        Interfaces.C.Pointers (Index              => Interfaces.C.size_t,
+                               Element            => Interfaces.C.char,
+                               Element_Array      => Interfaces.C.char_array,
+                               Default_Terminator => Interfaces.C.nul);
+
+      Char_Ptr : Char_Pointers.Pointer;
+
+      use type Char_Pointers.Pointer;
+
+   begin
+
+      -- Check that the Function Value with Pointer and Terminator Element 
+      -- parameters will return an Element_Array result of appropriate size 
+      -- and content (up to and including the first "terminator" Element.) 
+
+      Char_Ptr := TC_Char_Array(0)'Access;
+
+      -- Provide a new Terminator char in the call of Function Value.
+      -- This call should return only a portion (the first 10 chars) of
+      -- the referenced char_array, up to and including the char 'j'.
+
+      TC_Char_Array_1 := Char_Pointers.Value(Ref        => Char_Ptr,
+                                             Terminator => Char_j);
+
+      if Interfaces.C.To_Ada(TC_Char_Array_1, False) /= TC_String_1 or
+         Interfaces.C.Is_Nul_Terminated(TC_Char_Array_1)
+      then
+         Report.Failed("Incorrect result from Function Value with Ref " &
+                       "and Terminator parameters, when supplied with " &
+                       "a non-default Terminator char");
+      end if;
+
+      -- Use the default Terminator char in the call of Function Value.
+      -- This call should return the entire char_array, including the 
+      -- terminating nul char.
+
+      TC_Char_Array_2 := Char_Pointers.Value(Char_Ptr);
+
+      if Interfaces.C.To_Ada(TC_Char_Array_2, True) /= TC_String_2 or
+         not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_2)
+      then
+         Report.Failed("Incorrect result from Function Value with Ref " &
+                       "and Terminator parameters, when using the "     &
+                       "default Terminator char");
+      end if;
+
+
+
+      -- Check that the Function Value with Pointer and Length parameters 
+      -- will return an Element_Array result of appropriate size and content
+      -- (the first Length elements pointed to by the parameter Ref).
+      
+      -- This call should return only a portion (the first 20 chars) of
+      -- the referenced char_array.
+
+      TC_Char_Array_3 := 
+        Char_Pointers.Value(Ref    => Char_Ptr,
+                            Length => Interfaces.C.ptrdiff_t(TC_Array_Size));
+
+      -- Verify the individual chars of the result.
+      for i in 0..TC_Array_Size-1 loop
+         if Interfaces.C.To_Ada(TC_Char_Array_3(i)) /= 
+            TC_String_3(Integer(i)+1)
+         then
+            Report.Failed("Incorrect result from Function Value with "  &
+                          "Ref and Length parameters, when specifying " &
+                          "a length less than the full array size");
+            exit;
+         end if;
+      end loop;
+
+      -- This call should return the entire char_array, including the 
+      -- terminating nul char.
+
+      TC_Char_Array_4 := Char_Pointers.Value(Char_Ptr, 27);
+
+      if Interfaces.C.To_Ada(TC_Char_Array_4, True) /= TC_String_4 or
+         not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_4)
+      then
+         Report.Failed("Incorrect result from Function Value with Ref " &
+                       "and Length parameters, when specifying the "    &
+                       "entire array size");
+      end if;
+
+
+
+      -- Check that both of the above versions of Function Value will 
+      -- propagate Interfaces.C.Strings.Dereference_Error when the value of
+      -- the Ref Pointer parameter is null.
+
+      Char_Ptr := null;
+
+      begin
+         TC_Char_Array_1 := Char_Pointers.Value(Ref        => Char_Ptr,
+                                                Terminator => Char_j);
+         Report.Failed("Dereference_Error not raised by Function " &
+                       "Value with Terminator parameter, when "    &
+                       "provided a null reference");
+         -- Call Report.Comment to ensure that the assignment to 
+         -- TC_Char_Array_1 is not "dead", and therefore can not be 
+         -- optimized away.
+         Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_1, False));
+      exception
+         when Interfaces.C.Strings.Dereference_Error => 
+           null;  -- OK, expected exception.
+         when others =>
+           Report.Failed("Incorrect exception raised by Function " &
+                         "Value with Terminator parameter, when "  &
+                         "provided a null reference");
+      end;
+
+
+      begin
+         TC_Char_Array_3 := 
+           Char_Pointers.Value(Char_Ptr,
+                               Interfaces.C.ptrdiff_t(TC_Array_Size));
+         Report.Failed("Dereference_Error not raised by Function "   &
+                       "Value with Length parameter, when provided " &
+                       "a null reference");
+         -- Call Report.Comment to ensure that the assignment to 
+         -- TC_Char_Array_3 is not "dead", and therefore can not be 
+         -- optimized away.
+         Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_3, False));
+      exception
+         when Interfaces.C.Strings.Dereference_Error => 
+           null;  -- OK, expected exception.
+         when others =>
+           Report.Failed("Incorrect exception raised by Function " &
+                         "Value with Length parameter, when "      &
+                         "provided a null reference");
+      end;
+
+
+   exception
+      when others => Report.Failed ("Exception raised in Test_Block");
+   end Test_Block;
+
+   Report.Result;
+
+end CXB3014;