From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-0.9 required=5.0 tests=BAYES_00,FORGED_GMAIL_RCVD,
	FREEMAIL_FROM autolearn=no autolearn_force=no version=3.4.4
Path: 
 border1.nntp.dca3.giganews.com!border3.nntp.dca.giganews.com!border1.nntp.dca.giganews.com!nntp.giganews.com!usenet.blueworldhosting.com!feeder02.blueworldhosting.com!eternal-september.org!feeder.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Natasha Kerensikova <lithiumcat@gmail.com>
Newsgroups: comp.lang.ada
Subject: Access check failed without using the word "access" in source
Date: Thu, 22 Aug 2013 14:26:36 +0000 (UTC)
Organization: A noiseless patient Spider
Message-ID: <slrnl1c7ro.1lme.lithiumcat@sigil.instinctive.eu>
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Injection-Date: Thu, 22 Aug 2013 14:26:36 +0000 (UTC)
Injection-Info: mx05.eternal-september.org;
 posting-host="31d6bde745a337034b005384ef225743";
 logging-data="29630"; mail-complaints-to="abuse@eternal-september.org";
 posting-account="U2FsdGVkX1+tpvzQ/9p0qgw+j0Ix8dnT"
User-Agent: slrn/0.9.9p1 (FreeBSD)
Cancel-Lock: sha1:OuD00XBLfIGOrkRlKOlYhQFGcNw=
X-Original-Bytes: 4480
Xref: number.nntp.dca.giganews.com comp.lang.ada:183099
Date: 2013-08-22T14:26:36+00:00
List-Id: <comp.lang.ada>

Hello,

running the code below after compiling it with GNAT GPL 2013, I get a
Constraint_Error because of an access check failure, even though the
source does not contain a single occurrence of the word "access".

However I might be doing something so wrong it escape compiler warnings,
so I'm submitting here before concluding about a compiler bug.
Do you see anything wrong with my code or is it supposed to run fine?

Below is the source, the compilation commands, and my first
pokings-in-the-dark about a probable cause.

Thanks in advance for your help.




$ cat >testcase.ada <<-EOF
package P is

   type I is limited interface;

end P;

with Ada.Finalization;

package P.C is

   type H is private;

   function Create (S : String) return H;

   function Process (Self : H) return I'Class;

   function Process (S : String) return I'Class;

private

   type H is null record;

   type Internal is new Ada.Finalization.Limited_Controlled and I
     with null record;

end P.C;

package body P.C is

   function Create (S : String) return H is
   begin
      return H'(null record);
   end Create;

   function Process (Self : H) return I'Class is
   begin
      return Internal'(Ada.Finalization.Limited_Controlled with null record);
   end Process;

   function Process (S : String) return I'Class is
   begin
      return Process (Create (S));
   end Process;

end P.C;

with Ada.Text_IO;

with P.C;

procedure Main is
begin
   Ada.Text_IO.Put_Line ("Begin");

   declare
      Object : P.I'Class := P.C.Process ("foo");
   begin
      null;
   end;

   Ada.Text_IO.Put_Line ("End");
end Main;
EOF

$ gnatchop testcase.ada
splitting testcase.ada into:
   p.ads
   p-c.ads
   p-c.adb
   main.adb
$ gnatmake main.adb
gcc -c main.adb
gcc -c p.ads
gcc -c p-c.adb
gnatbind -x main.ali
gnatlink main.ali
$ ./main
Begin

raised CONSTAINT_ERROR p-c.adb:16 access check failed
$ rm *.o *.ali
$ gnatmake -gnatD main.adb
gcc -c -gnatD main.adb
gcc -c -gnatD p.ads
gcc -c -gnatD p-c.adb
gnatbind -x main.ali
gnatlink main.ali
$ ./main
Begin

raised CONSTAINT_ERROR p-c.adb.dg:322 access check failed
$ nl -ba p-c.adb.bg | sed -n 319,332p
   319	         [constraint_error when
   320	           ada__tags__addr_ptr!(C85b) = null
   321	           "access check failed"]
   322	         [constraint_error when
   323	           ada__tags__type_specific_data_ptr!(ada__tags__addr_ptr!(C85b).all) =
   324	             null
   325	           "access check failed"]
   326	         [program_error when
   327	           ada__tags__type_specific_data_ptr!(ada__tags__addr_ptr!(C85b).all).all.
   328	             access_level > 0
   329	           "accessibility check failed"]
   330	         return R76b;
   331	      end R77b;
   332	   end p__c__process;

So from what I understand here, P.C.Process doesn't return a P.I'Class
object (as in the actual source) but rather an access (or a pointer, not
sure about the correct vocabulary at this level), which a reasonable
implementation.

The snipped quoted above looks like a "not null" check and an
accessibility check on the return value of the inner P.C.Process, before
returning it in the outer P.C.Process.

And indeed, the access returned by the inner P.C.Process is not null,
but the access/pointer to the accessibility level is.

At this point, I have no idea what further conclusions can be drawn from
here...