From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.5-pre1 (2020-06-20) on
	ip-172-31-74-118.ec2.internal
X-Spam-Level: 
X-Spam-Status: No, score=-0.9 required=3.0 tests=BAYES_00,FORGED_GMAIL_RCVD,
	FREEMAIL_FROM autolearn=no autolearn_force=no version=3.4.5-pre1
Path: eternal-september.org!reader02.eternal-september.org!.POSTED!not-for-mail
From: Marek <ficorax@gmail.com>
Newsgroups: comp.lang.ada
Subject: Messing with access types...
Date: Mon, 28 Dec 2020 10:44:47 +0100
Organization: A noiseless patient Spider
Message-ID: <rsc9eg$a2h$1@dont-email.me>
Mime-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: 7bit
Injection-Date: Mon, 28 Dec 2020 09:44:48 -0000 (UTC)
Injection-Info: reader02.eternal-september.org; posting-host="90e115cbd48b0617eb8c616852774cd4";
	logging-data="10321"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX18c94zq/Dfca9bluX2Xp/c7"
User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:78.0) Gecko/20100101
 Thunderbird/78.5.0
Cancel-Lock: sha1:08klagfkihiQUm+hJzyo5OxL2cY=
Content-Language: en-US
X-Mozilla-News-Host: snews://news.eternal-september.org:563
Xref: reader02.eternal-september.org comp.lang.ada:60961
List-Id: <comp.lang.ada>

Hello,

I have some code:

- util.ads:

with System;

package Util is

   type Handle is record
      Str  : access String;
      Data : System.Address;
   end record;

   type Handle_Access is access all Handle;

   Null_Handle : constant Handle := (null, System.Null_Address);

   type Handle_Array is array (Natural range <>) of aliased Handle;

   generic
      type T is private;
      type T_Access is access all T;
   function Get_Data (H : access Handle; Str : access String) return
T_Access;

   generic
      type T is private;
      type T_Access is access all T;
   function Get_Query
     (H        : access Handle; Str : access String; Data : in out T_Access;
      Required : Boolean) return access String;

end Util;

- util.adb

pragma Ada_2012;

with Interfaces.C.Pointers;

with System.Address_To_Access_Conversions;

package body Util is

   package Ptr is new Interfaces.C.Pointers
     (Index              => Natural,
      Element            => Handle,
      Element_Array      => Handle_Array,
      Default_Terminator => Null_Handle);

   use Ptr;

   --------------
   -- Get_Data --
   --------------

   function Get_Data (H : access Handle; Str : access String) return
T_Access
   is
      Pointer : Ptr.Pointer := Ptr.Pointer (H);

      package ATA is new System.Address_To_Access_Conversions (T);

   begin
      if H /= null then
         loop
            declare
               F : access Handle := Pointer;
            begin
               if Str.all = F.Str.all then
                  return T_Access (ATA.To_Pointer (F.Data));
               end if;
            end;

            Ptr.Increment (Pointer);

            exit when Pointer = null;

         end loop;
      end if;

      return null;
   end Get_Data;

   ---------------
   -- Get_Query --
   ---------------

   function Get_Query
     (H        : access Handle; Str : access String; Data : in out T_Access;
      Required : Boolean) return access String
   is
      function Get is new Get_Data (T, T_Access);
   begin

      Data := Get (H, Str);

      if Required and (Data /= null) then
         return Str;
      end if;

      return null;
   end Get_Query;

end Util;

- test.adb

pragma Ada_2012;

with Util;

procedure Test is
   use Util;

   type Some_Record is record
      Foo : Integer;
   end record;

   type Some_Record_Access is access all Some_Record;

   Test_Record : Some_Record_Access;

   H : access Handle := null;

   Str : access String := new String'("Test");

   function Query is new Get_Query (Some_Record, Some_Record_Access);

   Result : access String := Query (H, Str, Test_Record, False);
begin
   null;
end Test;

When I try to compile test.adb I get some warnings:

Compile
   [Ada]          test.adb
test.adb:20:04: warning: in instantiation at util.adb:34
test.adb:20:04: warning: in instantiation at util.adb:56
test.adb:20:04: warning: accessibility check failure
test.adb:20:04: warning: "Program_Error" will be raised at run time
test.adb:20:04: warning: in instantiation at util.adb:34
test.adb:20:04: warning: in instantiation at util.adb:56
test.adb:20:04: warning: cannot convert local pointer to non-local
access type
test.adb:20:04: warning: Program_Error will be raised at run time
   [Ada]          util.adb
Bind
   [gprbind]      test.bexch
   [Ada]          test.ali
Link
   [link]         test.adb
[2020-12-28 10:30:50] process terminated successfully, elapsed time: 00.92s

I tried also to move every local (to Test procedure) variables to global
scope but result is the same.

What is going on? Can you explain where is the problem?
thanks in advance

Marek