[multiple changes]

2014-02-06  Robert Dewar  <dewar@adacore.com>

	* casing.adb (Determine_Casing): Consider SPARK_Mode to be
	mixed case.

2014-02-06  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch6.adb (Is_Build_In_Place_Function): Predicate is false
	when the function has a foreign convention, but not if only the
	limited return type has such a convention.

2014-02-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch3.adb (Handle_Late_Controlled_Primitive): Remove local
	variable Spec. Comment reformatting. Use Copy_Separate_Tree
	rather than New_Copy_Tree when building the corresponding
	subprogram declaration.

2014-02-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Global_Item): Remove
	the mode-related checks on abstract states with enabled external
	properties.
	(Property_Error): Removed.

2014-02-06  Javier Miranda  <miranda@adacore.com>

	* lib-xref.adb (Generate_Reference): When
	generating the reference to the first private entity take care
	of handling swapped entities.

From-SVN: r207547

6 files changed, 78 insertions, 78 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d61f774..463e268 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,34 @@
+2014-02-06  Robert Dewar  <dewar@adacore.com>
+
+	* casing.adb (Determine_Casing): Consider SPARK_Mode to be
+	mixed case.
+
+2014-02-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch6.adb (Is_Build_In_Place_Function): Predicate is false
+	when the function has a foreign convention, but not if only the
+	limited return type has such a convention.
+
+2014-02-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch3.adb (Handle_Late_Controlled_Primitive): Remove local
+	variable Spec. Comment reformatting. Use Copy_Separate_Tree
+	rather than New_Copy_Tree when building the corresponding
+	subprogram declaration.
+
+2014-02-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Analyze_Global_Item): Remove
+	the mode-related checks on abstract states with enabled external
+	properties.
+	(Property_Error): Removed.
+
+2014-02-06  Javier Miranda  <miranda@adacore.com>
+
+	* lib-xref.adb (Generate_Reference): When
+	generating the reference to the first private entity take care
+	of handling swapped entities.
+
 2014-02-06  Sergey Rybin  <rybin@adacore.com frybin>
 
 	* gnat_ugn.texi, vms_data.ads: Add documentation of -j option for
diff --git a/gcc/ada/casing.adb b/gcc/ada/casing.adb
index 4a0d855..dce1e0b 100644
--- a/gcc/ada/casing.adb
+++ b/gcc/ada/casing.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -59,6 +59,14 @@ package body Casing is
       --  True at start of string, and after an underline character
 
    begin
+      --  A special kludge, consider SPARK_Mode to be mixed case
+
+      if Ident = "SPARK_Mode" then
+         return Mixed_Case;
+      end if;
+
+      --  Proceed with normal determination
+
       for S in Ident'Range loop
          if Ident (S) = '_' or else Ident (S) = '.' then
             After_Und := True;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 556bfe0..3908584 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -9592,13 +9592,13 @@ package body Exp_Ch6 is
         or else (Ekind (E) = E_Subprogram_Type
                   and then Etype (E) /= Standard_Void_Type)
       then
-         --  Note: If you have Convention (C) on an inherently limited type,
-         --  you're on your own. That is, the C code will have to be carefully
-         --  written to know about the Ada conventions.
+         --  Note: If the function has a foreign convention, it cannot build
+         --  its result in place, so you're on your own. On the other hand,
+         --  if only the return type has a foreign convention, its layout is
+         --  intended to be compatible with the other language, but the build-
+         --  in place machinery can ensure that the object is not copied.
 
-         if Has_Foreign_Convention (E)
-           or else Has_Foreign_Convention (Etype (E))
-         then
+         if Has_Foreign_Convention (E) then
             return False;
 
          --  In Ada 2005 all functions with an inherently limited return type
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index 034e67a..fbbdc3f 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -1088,15 +1088,29 @@ package body Lib.Xref is
               and then Present (First_Private_Entity (E))
               and then In_Extended_Main_Source_Unit (N)
             then
-               Add_Entry
-                 ((Ent       => Ent,
-                   Loc       => Sloc (First_Private_Entity (E)),
-                   Typ       => 'E',
-                   Eun       => Get_Source_Unit (Def),
-                   Lun       => Get_Source_Unit (Ref),
-                   Ref_Scope => Empty,
-                   Ent_Scope => Empty),
-                  Ent_Scope_File => No_Unit);
+               --  Handle case in which the full-view and partial-view of the
+               --  first private entity are swapped
+
+               declare
+                  First_Private : Entity_Id := First_Private_Entity (E);
+
+               begin
+                  if Is_Private_Type (First_Private)
+                    and then Present (Full_View (First_Private))
+                  then
+                     First_Private := Full_View (First_Private);
+                  end if;
+
+                  Add_Entry
+                    ((Ent       => Ent,
+                      Loc       => Sloc (First_Private),
+                      Typ       => 'E',
+                      Eun       => Get_Source_Unit (Def),
+                      Lun       => Get_Source_Unit (Ref),
+                      Ref_Scope => Empty,
+                      Ent_Scope => Empty),
+                     Ent_Scope_File => No_Unit);
+               end;
             end if;
          end if;
       end if;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index be9e3e8..2f6eedb 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2110,7 +2110,6 @@ package body Sem_Ch3 is
          Loc       : constant Source_Ptr := Sloc (Body_Id);
          Params    : constant List_Id    :=
                        Parameter_Specifications (Body_Spec);
-         Spec      : Node_Id;
          Spec_Id   : Entity_Id;
 
          Dummy : Entity_Id;
@@ -2119,8 +2118,8 @@ package body Sem_Ch3 is
          --  spec analysis.
 
       begin
-         --  Consider only procedure bodies whose name matches one of type
-         --  [Limited_]Controlled's primitives.
+         --  Consider only procedure bodies whose name matches one of the three
+         --  controlled primitives.
 
          if Nkind (Body_Spec) /= N_Procedure_Specification
            or else not Nam_In (Chars (Body_Id), Name_Adjust,
@@ -2129,8 +2128,7 @@ package body Sem_Ch3 is
          then
             return;
 
-         --  A controlled primitive must have exactly one formal whose type
-         --  derives from [Limited_]Controlled.
+         --  A controlled primitive must have exactly one formal
 
          elsif List_Length (Params) /= 1 then
             return;
@@ -2138,6 +2136,8 @@ package body Sem_Ch3 is
 
          Dummy := Analyze_Subprogram_Specification (Body_Spec);
 
+         --  The type of the formal must be derived from [Limited_]Controlled
+
          if not Is_Controlled (Etype (Defining_Entity (First (Params)))) then
             return;
          end if;
@@ -2152,16 +2152,13 @@ package body Sem_Ch3 is
          end if;
 
          --  At this point the body is known to be a late controlled primitive.
-         --  Generate a matching spec and insert it before the body.
-
-         Spec := New_Copy_Tree (Body_Spec);
-
-         Set_Defining_Unit_Name
-           (Spec, Make_Defining_Identifier (Loc, Chars (Body_Id)));
+         --  Generate a matching spec and insert it before the body. Note the
+         --  use of Copy_Separate_Tree - we want an entirely separate semantic
+         --  tree in this case.
 
          Insert_Before_And_Analyze (Body_Decl,
            Make_Subprogram_Declaration (Loc,
-             Specification => Spec));
+             Specification => Copy_Separate_Tree (Body_Spec)));
       end Handle_Late_Controlled_Primitive;
 
       --------------------------------
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index dabc4bb..9549ade 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1912,34 +1912,8 @@ package body Sem_Prag is
            (Item        : Node_Id;
             Global_Mode : Name_Id)
          is
-            procedure Property_Error
-              (State_Id : Entity_Id;
-               Prop_Nam : Name_Id);
-            --  Emit an error concerning state State_Id with enabled property
-            --  Async_Readers, Effective_Reads or Effective_Writes that is not
-            --  marked as In_Out or Output item.
-
-            --------------------
-            -- Property_Error --
-            --------------------
-
-            procedure Property_Error
-              (State_Id : Entity_Id;
-               Prop_Nam : Name_Id)
-            is
-            begin
-               Error_Msg_Name_1 := Prop_Nam;
-               Error_Msg_NE
-                 ("external state & with enabled property % must have mode "
-                  & "In_Out or Output (SPARK RM 7.1.2(7))", Item, State_Id);
-            end Property_Error;
-
-            --  Local variables
-
             Item_Id : Entity_Id;
 
-         --  Start of processing for Analyze_Global_Item
-
          begin
             --  Detect one of the following cases
 
@@ -2018,30 +1992,6 @@ package body Sem_Prag is
                         Ref      => Item);
                   end if;
 
-                  --  Detect an external state with an enabled property that
-                  --  does not match the mode of the state.
-
-                  if Global_Mode = Name_Input then
-                     if Async_Readers_Enabled (Item_Id) then
-                        Property_Error (Item_Id, Name_Async_Readers);
-
-                     elsif Effective_Reads_Enabled (Item_Id) then
-                        Property_Error (Item_Id, Name_Effective_Reads);
-
-                     elsif Effective_Writes_Enabled (Item_Id) then
-                        Property_Error (Item_Id, Name_Effective_Writes);
-                     end if;
-
-                  elsif Global_Mode = Name_Output
-                    and then Async_Writers_Enabled (Item_Id)
-                  then
-                     Error_Msg_Name_1 := Name_Async_Writers;
-                     Error_Msg_NE
-                       ("external state & with enabled property % must have "
-                        & "mode Input or In_Out (SPARK RM 7.1.2(7))",
-                        Item, Item_Id);
-                  end if;
-
                --  Variable related checks
 
                else