[PATCH] ada/16086: Accept protected subprogram as generic formal default

Samuel Tardieu sam@rfc1149.net
Sat Apr 12 03:36:00 GMT 2008


I must admit that I am puzzled by this one: I have removed code
whose sole purpose seems to be the prevention of using protected
subprograms as generic formal defaults, accepting only entries.
However, according to RM 9.5.1(1), "a protected subprogram is a
subprogram" and thus should be usable in this context.

The removal of this code doesn't change the outcome of GCC GNAT and
ACATS tests. Can someone explain if this code is useful?

With this patch, the test program compiles and runs without an error,
while the current version of GNAT refuses to compile with:

    23.       with procedure Inc is Prot.Inc;
                                        |
        >>> expect valid subprogram name as default

    24.       with function Get return Integer is Prot.Get;
                                                      |
        >>> expect valid subprogram name as default

Regtested on i686-pc-linux-gnu.

Ok for trunk?

    gcc/ada/
	PR ada/16086
	* sem_ch12.adb (Analyze_Formal_Subprogram): Remove code
	specific to entries.

    gcc/testsuite/
	PR ada/16086
	* gnat.dg/prot_def.adb: New.
---
 gcc/ada/sem_ch12.adb               |   30 ++++++------------------
 gcc/testsuite/gnat.dg/prot_def.adb |   44 ++++++++++++++++++++++++++++++++++++
 2 files changed, 52 insertions(+), 22 deletions(-)
 create mode 100644 gcc/testsuite/gnat.dg/prot_def.adb

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 3ee96d1..673e7f4 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -2362,30 +2362,16 @@ 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 Etype (Def) = Any_Type then
+         if Etype (Def) = Any_Type
+           or else Nkind (Def) = N_Selected_Component
+         then
             return;
 
-         elsif Nkind (Def) = N_Selected_Component then
-            Subp := Entity (Selector_Name (Def));
-
-            if Ekind (Subp) /= E_Entry 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 Ekind (Subp) /= E_Entry_Family then
-                  Error_Msg_N ("expect valid subprogram name as default", Def);
-                  return;
-               end if;
-            end if;
+         elsif Nkind (Def) = N_Indexed_Component
+           and then Nkind (Prefix (Def)) /= N_Selected_Component
+         then
+            Error_Msg_N ("expect valid subprogram name as default", Def);
+            return;
 
          elsif Nkind (Def) = N_Character_Literal then
 
diff --git a/gcc/testsuite/gnat.dg/prot_def.adb b/gcc/testsuite/gnat.dg/prot_def.adb
new file mode 100644
index 0000000..d56195e
--- /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;
-- 
1.5.5.144.g3e42



More information about the Gcc-patches mailing list