[Ada] Ada 2012 accessibility checking

[Arnaud Charlet <charlet at adacore dot com>]

This set of changes improves support for AI05-0234's rules about how the
accessibility level of a function result object may be determined
by the point of call. The following test is intended to test this support.
The test should execute without producing output. Because this is an Ada2012
test, it must be compiled with the -gnat2012 option specified.

  procedure Check1 is
    subtype Subtest_Id is Integer range 1 .. 6;

    type Count is mod 3;
    Counter : Count := 0;

    Test_Failed : exception;

    type Drec (Int_Ref : access Integer) is
      record F1, F2 : Integer := 0; end record;

    type Global_Ref is access Drec;
    Global_Ptr : Global_Ref;

    procedure Nested (Subtest : Subtest_Id) is
        type Local_Ref is access Drec;
        Local_Ptr : Local_Ref;

        Local_Var : aliased Integer;
        Local_Drec : Drec (Local_Var'Access);

        function Checker return Drec is
        begin
            case Subtest is
                when 1 =>
                    -- positional aggregate
                    return Drec'(Local_Var'Access, 123, 456);
                when 2 =>
                    -- named aggregate
                    return Drec'(Int_Ref => Local_Var'Access,
                                 F1 => 123, F2 => 456);
                when 3 =>
                    -- mixed aggragate
                   return Drec'(F1 => 123,
                                Int_Ref => Local_Var'Access, F2 => 456);
                when 4 =>
                    -- extended return object subtype constrained
                    return X : Drec (Local_Var'Access);
                when 5 =>
                    -- extended return object subtype unconstrained
                    return X : Drec := Drec'(Local_Var'Access, 123, 455);
                when 6 =>
                    -- return existing object
                    return Local_Drec;
            end case;
        end Checker;

        function Checker_Wrapper return Drec is
        begin
            Counter := Counter + 1;
            if Counter = 0 then
                return Checker;
            else
                return Result : Drec := Checker;
            end if;
        end Checker_Wrapper;

        Checkers : constant array (1..2) of access function return Drec
          := (Checker'Access, Checker_Wrapper'Access);
    begin
        Local_Ptr := new Drec'(Checker);
        begin
            Global_Ptr := new Drec'(Checker);
            raise Test_Failed;
        exception
            when Program_Error =>
                null;
        end;

        Local_Ptr := new Drec'(Checker_Wrapper);
        begin
            Global_Ptr := new Drec'(Checker_Wrapper);
            raise Test_Failed;
        exception
            when Program_Error =>
                null;
        end;

        for Index in Checkers'Range loop
            Local_Ptr := new Drec'(Checkers (Index).all);
            begin
                Global_Ptr := new Drec'(Checkers (Index).all);
                raise Test_Failed;
            exception
                when Program_Error =>
                    null;
            end;
        end loop;
    end Nested;
  begin
   for Subtest in Subtest_Id loop
       Nested (Subtest);
   end loop;
  end Check1;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-09-06  Steve Baird  <baird@adacore.com>

	* einfo.ads (Extra_Accessibility): Update associated comment to use
	the term "present" correctly ("present" just means that it is not
	an error to query the value of the attribute - it does not imply
	that the value must be non-null).
	(Extra_Constrained): Ditto.
	(Is_Visible_Formal): Ditto.
	(Extra_Accessibility_Of_Result) Ditto; also add Inline pragma.
	(Set_Extra_Accessibility_Of_Result): Add Inline pragma.
	* exp_ch4.adb (Expand_Allocator_Expression): Improve a comment.
	* exp_ch6.adb (Expand_Call): The callee may require an
	Extra_Accessibility_Of_Result actual parameter even if Ada_Version
	< Ada_2012. This can occur if the callee is exported from a Gnat
	runtimes unit. Also improve a comment.

Attachment: difs
Description: Text document