[multiple changes]

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

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): A subprogram
	body generated for an expression function within a protected body
	needs a set of renaming declarations if the expression function
	comes from source.

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

	* lib-xref.adb (Get_Type_Reference): In semantics-only mode,
	list interface progenitor of a tagged concurrent type, for better
	source navigation.

2014-01-22  Robert Dewar  <dewar@adacore.com>

	* lib.adb (In_Extended_Main_Code_Unit): Return False for
	Standard_Location.
	(In_Extended_Main_Source_Unit): Return False for Standard_Location.
	* lib.ads (In_Extended_Main_Code_Unit): Add documentation on
	treatment of Slocs No_Location and Standard_Location.
	* restrict.adb (Check_Restriction_No_Dependence): Explicitly
	check for entity with Standard_Location Sloc, rather than relying
	on Lib routines to do that.
	* sem_res.adb (Resolve_Call): Implement SPARK_05 restriction
	that a call cannot occur before a later occuring body within
	the same unit.

From-SVN: r206931

7 files changed, 87 insertions, 8 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e8c2d2d..51f7ed6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2014-01-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): A subprogram
+	body generated for an expression function within a protected body
+	needs a set of renaming declarations if the expression function
+	comes from source.
+
+2014-01-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* lib-xref.adb (Get_Type_Reference): In semantics-only mode,
+	list interface progenitor of a tagged concurrent type, for better
+	source navigation.
+
+2014-01-22  Robert Dewar  <dewar@adacore.com>
+
+	* lib.adb (In_Extended_Main_Code_Unit): Return False for
+	Standard_Location.
+	(In_Extended_Main_Source_Unit): Return False for Standard_Location.
+	* lib.ads (In_Extended_Main_Code_Unit): Add documentation on
+	treatment of Slocs No_Location and Standard_Location.
+	* restrict.adb (Check_Restriction_No_Dependence): Explicitly
+	check for entity with Standard_Location Sloc, rather than relying
+	on Lib routines to do that.
+	* sem_res.adb (Resolve_Call): Implement SPARK_05 restriction
+	that a call cannot occur before a later occuring body within
+	the same unit.
+
 2014-01-22  Thomas Quinot  <quinot@adacore.com>
 
 	* rtsfind.adb: Update comment.
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index 14462ce..409e736 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -1309,6 +1309,22 @@ package body Lib.Xref is
                         Right := '>';
                      end if;
 
+                  --  For a synchronized type that implements an interface, we
+                  --  treat the first progenitor as the parent. This is only
+                  --  needed when compiling a package declaration on its own,
+                  --  if the body is present interfaces are handled properly.
+
+                  elsif Is_Concurrent_Type (Tref)
+                    and then Is_Tagged_Type (Tref)
+                    and then not Expander_Active
+                  then
+                     if Left /= '(' then
+                        Left := '<';
+                        Right := '>';
+                     end if;
+
+                     Tref := Entity (First (Interface_List (Parent (Tref))));
+
                   --  If the completion of a private type is itself a derived
                   --  type, we need the parent of the full view.
 
diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb
index b43ad98..9ea496f 100644
--- a/gcc/ada/lib.adb
+++ b/gcc/ada/lib.adb
@@ -718,7 +718,7 @@ package body Lib is
    is
    begin
       if Sloc (N) = Standard_Location then
-         return True;
+         return False;
 
       elsif Sloc (N) = No_Location then
          return False;
@@ -750,7 +750,7 @@ package body Lib is
    function In_Extended_Main_Code_Unit (Loc : Source_Ptr) return Boolean is
    begin
       if Loc = Standard_Location then
-         return True;
+         return False;
 
       elsif Loc = No_Location then
          return False;
@@ -787,7 +787,7 @@ package body Lib is
       --  Special value cases
 
       elsif Nloc = Standard_Location then
-         return True;
+         return False;
 
       elsif Nloc = No_Location then
          return False;
@@ -826,7 +826,7 @@ package body Lib is
       --  Special value cases
 
       elsif Loc = Standard_Location then
-         return True;
+         return False;
 
       elsif Loc = No_Location then
          return False;
diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads
index 00959cd..5c490cd 100644
--- a/gcc/ada/lib.ads
+++ b/gcc/ada/lib.ads
@@ -520,6 +520,14 @@ package Lib is
    --  instantiations are included in the extended main unit for this call.
    --  If the main unit is itself a subunit, then the extended main code unit
    --  includes its parent unit, and the parent unit spec if it is separate.
+   --
+   --  This routine (and the following three routines) all return False if
+   --  Sloc (N) is No_Location or Standard_Location. In an earlier version,
+   --  they returned True for Standard_Location, but this was odd, and some
+   --  archeology indicated that this was done for the sole benefit of the
+   --  call in Restrict.Check_Restriction_No_Dependence, so we have moved
+   --  the special case check to that routine. This avoids some difficulties
+   --  with some other calls that malfunctioned with the odd return of True.
 
    function In_Extended_Main_Code_Unit (Loc : Source_Ptr) return Boolean;
    --  Same function as above, but argument is a source pointer rather
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index e244526..01c5f87 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -625,8 +625,12 @@ package body Restrict is
    begin
       --  Ignore call if node U is not in the main source unit. This avoids
       --  cascaded errors, e.g. when Ada.Containers units with other units.
+      --  However, allow Standard_Location here, since this catches some cases
+      --  of constructs that get converted to run-time calls.
 
-      if not In_Extended_Main_Source_Unit (U) then
+      if not In_Extended_Main_Source_Unit (U)
+        and then Sloc (U) /= Standard_Location
+      then
          return;
       end if;
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 9793aa4..62dd889 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -3218,13 +3218,13 @@ package body Sem_Ch6 is
       --  family index (if applicable). This form of early expansion is done
       --  when the Expander is active because Install_Private_Data_Declarations
       --  references entities which were created during regular expansion. The
-      --  body may be the rewritting of an expression function, and we need to
-      --  verify that the original node is in the source.
+      --  subprogram entity must come from source, and not be an internally
+      --  generated subprogram.
 
       if Expander_Active
-        and then Comes_From_Source (Original_Node (N))
         and then Present (Prot_Typ)
         and then Present (Spec_Id)
+        and then Comes_From_Source (Spec_Id)
         and then not Is_Eliminated (Spec_Id)
       then
          Install_Private_Data_Declarations
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 9289971..537a6e1 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5468,6 +5468,30 @@ package body Sem_Res is
          end if;
       end if;
 
+      --  If the SPARK_05 restriction is active, we are not allowed
+      --  to have a call to a subprogram before we see its completion.
+
+      if not Has_Completion (Nam)
+        and then Restriction_Check_Required (SPARK_05)
+
+        --  Don't flag strange internal calls
+
+        and then Comes_From_Source (N)
+        and then Comes_From_Source (Nam)
+
+        --  Only flag calls in extended main source
+
+        and then In_Extended_Main_Source_Unit (Nam)
+        and then In_Extended_Main_Source_Unit (N)
+
+        --  Exclude enumeration literals from this processing
+
+        and then Ekind (Nam) /= E_Enumeration_Literal
+      then
+         Check_SPARK_Restriction
+           ("call to subprogram cannot appear before its body", N);
+      end if;
+
       --  Check that this is not a call to a protected procedure or entry from
       --  within a protected function.