2010-10-05 Robert Dewar <dewar@adacore.com>

	* sem_ch4.adb: Minor reformatting.
	* a-direct.ads: Minor comment update.

2010-10-05  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Add_Internal_Interface_Entities): Removing code that is
	no longer required after change in New_Overloaded_Entity.
	* sem_ch6.adb (New_Overloaded_Entity): Code reorganization to isolate
	the fragment of code that handles derivations of interface primitives.
	Add missing dependence on global variable Inside_Freezing_Actions to
	ensure the correct management of internal interface entities.
	* sem_ch13.adb (Analyze_Freeze_Entity): Add missing increase/decrease
	of the global variable Inside_Freezing_Actions to ensure that internal
	interface entities are well handled by New_Overloaded_Entity.
	* sem_disp.adb (Find_Primitive_Covering_Interface): Add documentation
	and complete the algorithm to catch hidden primitives derived of
	private type that covers the interface.
	* sem_disp.ads (Find_Primitive_Covering_Interface): Add missing
	documentation.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164982 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 127 insertions, 67 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 787adbd0087..db244c2e037 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,27 @@
 2010-10-05  Robert Dewar  <dewar@adacore.com>
 
+	* sem_ch4.adb: Minor reformatting.
+	* a-direct.ads: Minor comment update.
+
+2010-10-05  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch3.adb (Add_Internal_Interface_Entities): Removing code that is
+	no longer required after change in New_Overloaded_Entity.
+	* sem_ch6.adb (New_Overloaded_Entity): Code reorganization to isolate
+	the fragment of code that handles derivations of interface primitives.
+	Add missing dependence on global variable Inside_Freezing_Actions to
+	ensure the correct management of internal interface entities.
+	* sem_ch13.adb (Analyze_Freeze_Entity): Add missing increase/decrease
+	of the global variable Inside_Freezing_Actions to ensure that internal
+	interface entities are well handled by New_Overloaded_Entity.
+	* sem_disp.adb (Find_Primitive_Covering_Interface): Add documentation
+	and complete the algorithm to catch hidden primitives derived of
+	private type that covers the interface.
+	* sem_disp.ads (Find_Primitive_Covering_Interface): Add missing
+	documentation.
+
+2010-10-05  Robert Dewar  <dewar@adacore.com>
+
 	* prj-util.adb, prj-util.ads, prj.ads, s-vxwext-rtp.adb, sem_ch4.adb,
 	sem_ch7.adb, sem_res.adb, sem_type.adb: Minor reformatting.
 	Minor code reorganization (use Nkind_In).
diff --git a/gcc/ada/a-direct.ads b/gcc/ada/a-direct.ads
index a5793b9b20a..4ad42999257 100644
--- a/gcc/ada/a-direct.ads
+++ b/gcc/ada/a-direct.ads
@@ -200,14 +200,14 @@ package Ada.Directories is
    --        timestamps:     Preserve the timestamp of the copied file, but not
    --                        the other file attributes.
    --
-   --
    --      The allowed values for mode= are:
    --
    --        copy:           Only copy if the destination file does not already
    --                        exist. If it already exists, Copy_File will fail.
    --
    --        overwrite:      Copy the file in all cases. Overwite an already
-   --                        existing destination file.
+   --                        existing destination file. This is the default if
+   --                        no mode= is found in Form.
    --
    --        append:         Append the original file to the destination file.
    --                        If the destination file does not exist, the
@@ -215,19 +215,17 @@ package Ada.Directories is
    --                        When mode=append, the field preserve=, if it
    --                        exists, is not taken into account.
    --
-   --    What is the default value for mode=???
-   --
    --    If the Form parameter includes one or both of the fields and the value
-   --    or values are incorrect, Copy_file fails with Use_Error.
+   --    or values are incorrect, Copy_File fails with Use_Error.
    --
    --    Examples of correct Forms:
    --       Form => "preserve=no_attributes,mode=overwrite" (the default)
    --       Form => "mode=append"
-   --       Form => "mode=copy, preserve=all_attributes"
+   --       Form => "mode=copy,preserve=all_attributes"
    --
    --    Examples of incorrect Forms:
    --       Form => "preserve=junk"
-   --       Form => "mode=internal, preserve=timestamps"
+   --       Form => "mode=internal,preserve=timestamps"
 
    ----------------------------------------
    -- File and directory name operations --
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 3d884eda7bd..e5d174bec4d 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2396,9 +2396,14 @@ package body Sem_Ch13 is
       E : constant Entity_Id := Entity (N);
 
    begin
+      --  Remember that we are processing a freezing entity. Required to
+      --  ensure correct decoration of internal entities associated with
+      --  interfaces (see New_Overloaded_Entity).
+
+      Inside_Freezing_Actions := Inside_Freezing_Actions + 1;
+
       --  For tagged types covering interfaces add internal entities that link
       --  the primitives of the interfaces with the primitives that cover them.
-
       --  Note: These entities were originally generated only when generating
       --  code because their main purpose was to provide support to initialize
       --  the secondary dispatch tables. They are now generated also when
@@ -2485,6 +2490,8 @@ package body Sem_Ch13 is
             end loop;
          end;
       end if;
+
+      Inside_Freezing_Actions := Inside_Freezing_Actions - 1;
    end Analyze_Freeze_Entity;
 
    ------------------------------------------
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 0b66cd6ece5..2192fcda2fc 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1550,22 +1550,7 @@ package body Sem_Ch3 is
                    (Tagged_Type => Tagged_Type,
                     Iface_Prim  => Iface_Prim);
 
-               --  Handle cases where the type has no primitive covering this
-               --  interface primitive.
-
-               if No (Prim) then
-
-                  --  Skip non-overridden null interface primitives because
-                  --  their wrappers will be generated later.
-
-                  if Is_Null_Interface_Primitive (Iface_Prim) then
-                     goto Continue;
-
-                  else
-                     pragma Assert (False);
-                     raise Program_Error;
-                  end if;
-               end if;
+               pragma Assert (Present (Prim));
 
                Derive_Subprogram
                  (New_Subp     => New_Subp,
@@ -1605,7 +1590,6 @@ package body Sem_Ch3 is
                Set_Has_Delayed_Freeze (New_Subp);
             end if;
 
-            <<Continue>>
             Next_Elmt (Elmt);
          end loop;
 
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 813a2977bf8..050a9d7cbe5 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -891,8 +891,8 @@ package body Sem_Ch4 is
 
          --  If this is an indirect call, the return type of the access_to
          --  subprogram may be an incomplete type. At the point of the call,
-         --  use the full type if available, and at the same time update
-         --  the return type of the access_to_subprogram.
+         --  use the full type if available, and at the same time update the
+         --  return type of the access_to_subprogram.
 
          if Success
            and then Nkind (Nam) = N_Explicit_Dereference
@@ -920,12 +920,12 @@ package body Sem_Ch4 is
 
             --  Name may be call that returns an access to subprogram, or more
             --  generally an overloaded expression one of whose interpretations
-            --  yields an access to subprogram. If the name is an entity, we
-            --  do not dereference, because the node is a call that returns
-            --  the access type: note difference between f(x), where the call
-            --  may return an access subprogram type, and f(x)(y), where the
-            --  type returned by the call to f is implicitly dereferenced to
-            --  analyze the outer call.
+            --  yields an access to subprogram. If the name is an entity, we do
+            --  not dereference, because the node is a call that returns the
+            --  access type: note difference between f(x), where the call may
+            --  return an access subprogram type, and f(x)(y), where the type
+            --  returned by the call to f is implicitly dereferenced to analyze
+            --  the outer call.
 
             if Is_Access_Type (Nam_Ent) then
                Nam_Ent := Designated_Type (Nam_Ent);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 6994b40aeb3..8478b7e0254 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7542,6 +7542,53 @@ package body Sem_Ch6 is
 
       E := Current_Entity_In_Scope (S);
 
+      --  Ada 2005 (AI-251): Derivation of abstract interface primitives.
+      --  They are directly added to the list of primitive operations of
+      --  Derived_Type, unless this is a rederivation in the private part
+      --  of an operation that was already derived in the visible part of
+      --  the current package.
+
+      if Ada_Version >= Ada_05
+        and then Present (Derived_Type)
+        and then Present (Alias (S))
+        and then Is_Dispatching_Operation (Alias (S))
+        and then Present (Find_Dispatching_Type (Alias (S)))
+        and then Is_Interface (Find_Dispatching_Type (Alias (S)))
+      then
+         --  For private types, when the full-view is processed we propagate to
+         --  the full view the non-overridden entities whose attribute "alias"
+         --  references an interface primitive. These entities were added by
+         --  Derive_Subprograms to ensure that interface primitives are
+         --  covered.
+
+         --  Inside_Freeze_Actions is non zero when S corresponds with an
+         --  internal entity that links an interface primitive with its
+         --  covering primitive through attribute Interface_Alias (see
+         --  Add_Internal_Interface_Entities)
+
+         if Inside_Freezing_Actions = 0
+           and then Is_Package_Or_Generic_Package (Current_Scope)
+           and then In_Private_Part (Current_Scope)
+           and then Nkind (Parent (E)) = N_Private_Extension_Declaration
+           and then Nkind (Parent (S)) = N_Full_Type_Declaration
+           and then Full_View (Defining_Identifier (Parent (E)))
+                      = Defining_Identifier (Parent (S))
+           and then Alias (E) = Alias (S)
+         then
+            Check_Operation_From_Private_View (S, E);
+            Set_Is_Dispatching_Operation (S);
+
+         --  Common case
+
+         else
+            Enter_Overloaded_Entity (S);
+            Check_Dispatching_Operation (S, Empty);
+            Check_For_Primitive_Subprogram (Is_Primitive_Subp);
+         end if;
+
+         return;
+      end if;
+
       --  If there is no homonym then this is definitely not overriding
 
       if No (E) then
@@ -7617,31 +7664,6 @@ package body Sem_Ch6 is
       --  E exists and is overloadable
 
       else
-         --  Ada 2005 (AI-251): Derivation of abstract interface primitives.
-         --  They are directly added to the list of primitive operations of
-         --  Derived_Type, unless this is a rederivation in the private part
-         --  of an operation that was already derived in the visible part of
-         --  the current package.
-
-         if Ada_Version >= Ada_05
-           and then Present (Derived_Type)
-           and then Present (Alias (S))
-           and then Is_Dispatching_Operation (Alias (S))
-           and then Present (Find_Dispatching_Type (Alias (S)))
-           and then Is_Interface (Find_Dispatching_Type (Alias (S)))
-         then
-            if Type_Conformant (E, S)
-              and then Is_Package_Or_Generic_Package (Current_Scope)
-              and then In_Private_Part (Current_Scope)
-              and then Parent (E) /= Parent (S)
-              and then Alias (E) = Alias (S)
-            then
-               Check_Operation_From_Private_View (S, E);
-            else
-               goto Add_New_Entity;
-            end if;
-         end if;
-
          Check_Synchronized_Overriding (S, Overridden_Subp);
 
          --  Loop through E and its homonyms to determine if any of them is
@@ -7999,8 +8021,6 @@ package body Sem_Ch6 is
             E := Homonym (E);
          end loop;
 
-         <<Add_New_Entity>>
-
          --  On exit, we know that S is a new entity
 
          Enter_Overloaded_Entity (S);
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 0cec5546faa..3c295f94ca3 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -1661,7 +1661,9 @@ package body Sem_Disp is
                      Is_Interface
                        (Find_Dispatching_Type (Ultimate_Alias (Iface_Prim)))));
 
-      --  Search in the homonym chain
+      --  Search in the homonym chain. Done to speed up locating visible
+      --  entities and required to catch primitives associated with the partial
+      --  view of private types when processing the corresponding full view.
 
       E := Current_Entity (Iface_Prim);
       while Present (E) loop
@@ -1675,16 +1677,39 @@ package body Sem_Disp is
          E := Homonym (E);
       end loop;
 
-      --  Search in the list of primitives of the type
+      --  Search in the list of primitives of the type. Required to locate the
+      --  covering primitive if the covering primitive is not visible (for
+      --  example, non-visible inherited primitive of private type).
 
       El := First_Elmt (Primitive_Operations (Tagged_Type));
       while Present (El) loop
          E := Node (El);
 
-         if No (Interface_Alias (E))
-           and then Alias (E) = Iface_Prim
-         then
-            return Node (El);
+         --  Keep separate the management of internal entities that link
+         --  primitives with interface primitives from tagged type primitives.
+
+         if No (Interface_Alias (E)) then
+            if Present (Alias (E)) then
+
+               --  This interface primitive has not been covered yet
+
+               if Alias (E) = Iface_Prim then
+                  return E;
+
+               --  The covering primitive was inherited
+
+               elsif Overridden_Operation (Ultimate_Alias (E))
+                       = Iface_Prim
+               then
+                  return E;
+               end if;
+            end if;
+
+         --  Use the internal entity that links the interface primitive with
+         --  the covering primitive to locate the entity
+
+         elsif Interface_Alias (E) = Iface_Prim then
+            return Alias (E);
          end if;
 
          Next_Elmt (El);
diff --git a/gcc/ada/sem_disp.ads b/gcc/ada/sem_disp.ads
index 428531d0338..64f7e20dc17 100644
--- a/gcc/ada/sem_disp.ads
+++ b/gcc/ada/sem_disp.ads
@@ -87,7 +87,11 @@ package Sem_Disp is
    --  associated with the partial view of private types when processing the
    --  corresponding full view. If the entity is not found then search for it
    --  in the list of primitives of Tagged_Type. This latter search is needed
-   --  when the interface primitive is covered by a private subprogram.
+   --  when the interface primitive is covered by a private subprogram. If the
+   --  primitive has not been covered yet then return the entity that will be
+   --  overriden when the primitive is covered (that is, return the entity
+   --  whose alias attribute references the interface primitive). If none of
+   --  these entities is found then return Empty.
 
    function Is_Dynamically_Tagged (N : Node_Id) return Boolean;
    --  Used to determine whether a call is dispatching, i.e. if is an