diff mbox

[Ada] Access types that designate limited views of types with tasks.

Message ID 20140801135039.GA27974@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Aug. 1, 2014, 1:50 p.m. UTC
This patch fixes the handling of access types whose designated types are
limited views of untagged types with tasks.

executing the following:

   gnatmake -q main.adb
   main

must yield:

   Task started
   Task started

---
with Package_Common; use Package_Common;
with Package_A; use Package_A;

procedure Main is
  pClassA : Class_A_Ptr := new Class_A;
  aClassA : access Class_A := new Class_A;
  pTypeA  : Type_A_Ptr := new Type_A;
  aTypeA  : access Type_A := new Type_A;
  pTaskA  : Task_A_Ptr := new Task_A;
  aTaskA  : access Task_A := new Task_A;
begin
  -- OK
  pClassA.Start;
  pClassA.Start;
  Start (pTypeA);
  Start (aTypeA);

  pTaskA.Start;

  aTaskA.Start;
end Main;
---
package Package_A is
  type Class_A is tagged null record;

  procedure Start (self : in out Class_A) is null;

  type Type_A is null record;

  procedure Start (obj : access Type_A) is null;

  task type Task_A is
    entry Start;
  end Task_A;
end Package_A;
---
limited with Package_A;
package Package_Common is

  type Class_A_Ptr is access all Package_A.Class_A;

  type Type_A_Ptr is access all Package_A.Type_A;

  type Task_A_Ptr is access all Package_A.Task_A;

end Package_Common;
---
with text_IO; use text_IO;
package body Package_A is

  task body Task_A is
  begin
    accept Start do
      Put_Line ("Task started");
    end;
  end Task_A;
end Package_A;

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

2014-08-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Access_Type_Declaration): If designated type is
	a limited view, create a master entity (as is already done for
	class-wide types) in case the full view designates a type that
	contains tasks.
	* sem_ch8.adb (Find_Selected_Component): If prefix is a dereference
	and the designated type is a limited view, use the non-limited
	view if available.
diff mbox

Patch

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 213451)
+++ sem_ch3.adb	(working copy)
@@ -1331,9 +1331,23 @@ 
 
          if Ekind (Root_Type (Entity (S))) = E_Incomplete_Type then
             Set_Directly_Designated_Type (T, Entity (S));
+
+            --  If the designated type is a limited view, we cannot tell if
+            --  the full view contains tasks, and there is no way to handle
+            --  that full view in a client. We create a master entity for the
+            --  scope, which will be used when a client determines that one
+            --  is needed.
+
+            if From_Limited_With (Entity (S))
+              and then not Is_Class_Wide_Type (Entity (S))
+            then
+               Set_Ekind (T, E_Access_Type);
+               Build_Master_Entity (T);
+               Build_Master_Renaming (T);
+            end if;
+
          else
-            Set_Directly_Designated_Type (T,
-              Process_Subtype (S, P, T, 'P'));
+            Set_Directly_Designated_Type (T, Process_Subtype (S, P, T, 'P'));
          end if;
 
          --  If the access definition is of the form: ACCESS NOT NULL ..
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb	(revision 213440)
+++ sem_ch8.adb	(working copy)
@@ -6236,6 +6236,25 @@ 
             Write_Entity_Info (P_Type, "      "); Write_Eol;
          end if;
 
+         --  The designated type may be a limited view with no components.
+         --  Check whether the non-limited view is available, because in some
+         --  cases this will not be set when instlling the context.
+
+         if Is_Access_Type (P_Type) then
+            declare
+               D : constant Entity_Id := Directly_Designated_Type (P_Type);
+            begin
+               if Is_Incomplete_Type (D)
+                 and then not Is_Class_Wide_Type (D)
+                 and then From_Limited_With (D)
+                 and then Present (Non_Limited_View (D))
+                 and then not Is_Class_Wide_Type (Non_Limited_View (D))
+               then
+                  Set_Directly_Designated_Type (P_Type,  Non_Limited_View (D));
+               end if;
+            end;
+         end if;
+
          --  First check for components of a record object (not the
          --  result of a call, which is handled below).