From: Samuel Tardieu <sam@gcc.gnu.org>
Date: Tue, 15 Apr 2008 11:02:58 +0000 (+0000)
Subject: [multiple changes]
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8abe457acb2207a1d3b3d5e020c532780276dcdd;p=gcc.git

[multiple changes]

2008-04-15  Ed Schonberg  <schonberg@adacore.com>

    gcc/ada/
	PR ada/16086
	* sem_ch12.adb (Analyze_Formal_Subprogram): The default can be any
	protected operation that matches the signature, not only an entry, a
	regular subprogram or a literal.

2008-04-15  Samuel Tardieu  <sam@rfc1149.net>

    gcc/testsuite/
	PR ada/16086
	* gnat.dg/prot_def.adb: New.

From-SVN: r134312
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d00479bb926..cec2e8cb2e5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2008-04-15  Ed Schonberg  <schonberg@adacore.com>
+
+	PR ada/16086
+	* sem_ch12.adb (Analyze_Formal_Subprogram): The default can be any
+	protected operation that matches the signature, not only an entry, a
+	regular subprogram or a literal.
+
 2008-04-15  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* ada-tree.h (DECL_BY_COMPONENT_PTR_P): Use DECL_LANG_FLAG_3.
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index e7755c4f534..c44f3929d50 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -2361,30 +2361,34 @@ package body Sem_Ch12 is
 
          --  Default name may be overloaded, in which case the interpretation
          --  with the correct profile must be  selected, as for a renaming.
+         --  If the definition is an indexed component, it must denote a
+         --  member of an entry family. If it is a selected component, it
+         --  can be a protected operation.
 
          if Etype (Def) = Any_Type then
             return;
 
          elsif Nkind (Def) = N_Selected_Component then
-            Subp := Entity (Selector_Name (Def));
-
-            if Ekind (Subp) /= E_Entry then
+            if not Is_Overloadable (Entity (Selector_Name (Def))) then
                Error_Msg_N ("expect valid subprogram name as default", Def);
-               return;
             end if;
 
          elsif Nkind (Def) = N_Indexed_Component then
-            if  Nkind (Prefix (Def)) /= N_Selected_Component then
-               Error_Msg_N ("expect valid subprogram name as default", Def);
-               return;
-
-            else
-               Subp := Entity (Selector_Name (Prefix (Def)));
+            if Is_Entity_Name (Prefix (Def)) then
+               if Ekind (Entity (Prefix (Def))) /= E_Entry_Family then
+                  Error_Msg_N ("expect valid subprogram name as default", Def);
+               end if;
 
-               if Ekind (Subp) /= E_Entry_Family then
+            elsif Nkind (Prefix (Def)) = N_Selected_Component then
+               if Ekind (Entity (Selector_Name (Prefix (Def))))
+                 /= E_Entry_Family
+               then
                   Error_Msg_N ("expect valid subprogram name as default", Def);
-                  return;
                end if;
+
+            else
+               Error_Msg_N ("expect valid subprogram name as default", Def);
+               return;
             end if;
 
          elsif Nkind (Def) = N_Character_Literal then
@@ -2410,6 +2414,9 @@ package body Sem_Ch12 is
             end if;
 
          else
+
+            --  Several interpretations. Disambiguate as for a renaming.
+
             declare
                I   : Interp_Index;
                I1  : Interp_Index := 0;
@@ -9778,6 +9785,8 @@ package body Sem_Ch12 is
          --  interface then  the generic formal is not unless declared
          --  explicitly so. If not declared limited, the actual cannot be
          --  limited (see AI05-0087).
+         --  Disable check for now, limited interfaces implemented by
+         --  protected types are common, Need to update tests ???
 
          if Is_Limited_Type (Act_T)
            and then not Is_Limited_Type (A_Gen_T)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d87b121e885..e3350a80c8e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-04-15  Samuel Tardieu  <sam@rfc1149.net>
+
+	PR ada/16086
+	* gnat.dg/prot_def.adb: New.
+
 2008-04-14  Ian Lance Taylor  <iant@google.com>
 
 	* gcc.dg/strict-overflow-6.c: New.
diff --git a/gcc/testsuite/gnat.dg/prot_def.adb b/gcc/testsuite/gnat.dg/prot_def.adb
new file mode 100644
index 00000000000..d56195ea483
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/prot_def.adb
@@ -0,0 +1,44 @@
+-- { dg-do run }
+procedure Prot_Def is
+
+   protected Prot is
+      procedure Inc;
+      function Get return Integer;
+   private
+      Data : Integer := 0;
+   end Prot;
+
+   protected body Prot is
+      procedure Inc is
+      begin
+         Data := Data + 1;
+      end Inc;
+      function Get return Integer is
+      begin
+         return Data;
+      end Get;
+   end Prot;
+
+   generic
+      with procedure Inc is Prot.Inc;
+      with function Get return Integer is Prot.Get;
+   package Gen is
+      function Add2_Get return Integer;
+   end Gen;
+
+   package body Gen is
+      function Add2_Get return Integer is
+      begin
+         Inc;
+	 Inc;
+	 return Get;
+      end Add2_Get;
+   end Gen;
+
+   package Inst is new Gen;
+
+begin
+   if Inst.Add2_Get /= 2 then
+      raise Constraint_Error;
+   end if;
+end Prot_Def;