gcc/testsuite/ada/acats/tests/cd/cd72a01.a

   1 --
   2 -- CD72A01.A
   3 --
   4 --                             Grant of Unlimited Rights
   5 --
   6 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   7 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   8 --     unlimited rights in the software and documentation contained herein.
   9 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
  10 --     this public release, the Government intends to confer upon all
  11 --     recipients unlimited rights  equal to those held by the Government.
  12 --     These rights include rights to use, duplicate, release or disclose the
  13 --     released technical data and computer software in whole or in part, in
  14 --     any manner and for any purpose whatsoever, and to have or permit others
  15 --     to do so.
  16 --
  17 --                                    DISCLAIMER
  18 --
  19 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  20 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  21 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  22 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  23 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  24 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  25 --*
  26 --
  27 -- OBJECTIVE:
  28 --      Check that the package System.Address_To_Access_Conversions may be
  29 --      instantiated for various simple types.
  30 --
  31 --      Check that To_Pointer and To_Address are inverse operations.
  32 --
  33 --      Check that To_Pointer(X'Address) equals X'Unchecked_Access for an
  34 --      X that allows Unchecked_Access.
  35 --
  36 --      Check that To_Pointer(Null_Address) returns null.
  37 --
  38 -- TEST DESCRIPTION:
  39 --      This test checks that the semantics provided in
  40 --      Address_To_Access_Conversions are present and operate
  41 --      within expectations (to the best extent possible in a portable
  42 --      implementation independent fashion).
  43 --
  44 --      The functions Address_To_Hex and Hex_To_Address test the invertability
  45 --      of the To_Integer and To_Address functions, along with a great deal
  46 --      of optimizer chaff and protection from the fact that type
  47 --      Storage_Elements.Integer_Address may be either a modular or a signed
  48 --      integer type.
  49 --
  50 --      This test has some interesting usage paradigms in that users
  51 --      occasionally want to store address information in a transportable
  52 --      fashion, and often resort to some textual representation of values.
  53 --
  54 -- APPLICABILITY CRITERIA:
  55 --      All implementations must attempt to compile this test.
  56 --
  57 --      For implementations validating against Systems Programming Annex (C):
  58 --        this test must execute and report PASSED.
  59 --
  60 --      For implementations not validating against Annex C:
  61 --        this test may report compile time errors at one or more points
  62 --        indicated by "-- ANX-C RQMT", in which case it may be graded as inapplicable.
  63 --        Otherwise, the test must execute and report PASSED.
  64 --
  65 -- CHANGE HISTORY:
  66 --      13 JUL 95   SAIC   Initial version (CD72001)
  67 --      08 FEB 96   SAIC   Revised (split) version for 2.1
  68 --      07 MAY 96   SAIC   Additional subtest added for 2.1
  69 --      16 FEB 98   EDS    Modified documentation.
  70 --!
  71
  72 with Report;
  73 with Impdef;
  74 with FD72A00;
  75 with System.Storage_Elements;
  76 with System.Address_To_Access_Conversions;
  77 procedure CD72A01 is
  78   use System;
  79   use FD72A00;
  80
  81   package Number_ATAC is
  82       new System.Address_To_Access_Conversions(Number); -- ANX-C RQMT
  83
  84   use type Number_ATAC.Object_Pointer;
  85
  86   type Data is record
  87     One, Two: aliased Number;
  88   end record;
  89
  90   package Data_ATAC is
  91       new System.Address_To_Access_Conversions(Data);   -- ANX-C RQMT
  92
  93   use type Data_ATAC.Object_Pointer;
  94
  95   type Test_Cases is ( Addr_Type, Record_Type );
  96
  97   type Naive_Dynamic_String is access String;
  98
  99   type String_Store is array(Test_Cases) of Naive_Dynamic_String;
 100
 101   The_Strings : String_Store;
 102
 103   -- create several aliased objects with distinct values
 104
 105   My_Number : aliased Number := Number'First;
 106   My_Data   : aliased Data   := (Number'First,Number'Last);
 107
 108    use type System.Storage_Elements.Integer_Address;
 109
 110 begin  -- Main test procedure.
 111
 112    Report.Test ("CD72A01", "Check package " &
 113                             "System.Address_To_Access_Conversions " &
 114                             "for simple types" );
 115
 116     -- take several pointer objects, convert them to addresses, and store
 117     -- the address as a hexadecimal representation for later reconversion
 118
 119     The_Strings(Addr_Type) := new String'(
 120       Address_To_Hex(Number_ATAC.To_Address(My_Number'Access)) );
 121
 122     The_Strings(Record_Type) := new String'(
 123       Address_To_Hex(Data_ATAC.To_Address(My_Data'Access)) );
 124
 125     -- now, reconvert the hexadecimal address values back to pointers,
 126     -- and check that the dereferenced pointer still designates the
 127     -- value placed at that location.  The use of the intermediate
 128     -- string representation should foil even the cleverest of optimizers
 129
 130     if Number_ATAC.To_Pointer(
 131                              Hex_To_Address(The_Strings(Addr_Type))).all
 132        /= Number'First then
 133       Report.Failed("Number reconversion");
 134     end if;
 135
 136     if Data_ATAC.To_Pointer(Hex_To_Address(The_Strings(Record_Type))).all
 137        /= (Number'First,Number'Last) then
 138       Report.Failed("Data reconversion");
 139     end if;
 140
 141     -- check that the resulting values are equal to the 'Unchecked_Access
 142     -- of the value
 143
 144     if Number_ATAC.To_Pointer(
 145                              Hex_To_Address(The_Strings(Addr_Type)))
 146        /= My_Number'Unchecked_Access then
 147       Report.Failed("Number Unchecked_Access");
 148     end if;
 149
 150     if Data_ATAC.To_Pointer(Hex_To_Address(The_Strings(Record_Type)))
 151        /= My_Data'Unchecked_Access then
 152       Report.Failed("Data Unchecked_Access");
 153     end if;
 154
 155    if Number_ATAC.To_Pointer(System.Null_Address) /= null then
 156      Report.Failed("To_Pointer(Null_Address) /= null");
 157    end if;
 158
 159    if Number_ATAC.To_Address(null) /= System.Null_Address then
 160      Report.Failed("To_Address(null) /= Null_Address");
 161    end if;
 162
 163    Report.Result;
 164
 165 end CD72A01;