2014-07-29 Robert Dewar <dewar@adacore.com>

	* frontend.adb, inline.adb, sem_util.adb, sem_res.adb,
	prepcomp.ads: Minor reformatting and code clean up.
	* exp_ch6.adb (Expand_Actuals): Generate predicate test
	unconditionally for case of OUT or IN OUT actual (before this
	was generated only for certain subcases, which is wrong, the
	test is always needed).



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

7 files changed, 109 insertions, 52 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9f1ccb7f1bf..0a8e374ae83 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2014-07-29  Robert Dewar  <dewar@adacore.com>
+
+	* frontend.adb, inline.adb, sem_util.adb, sem_res.adb,
+	prepcomp.ads: Minor reformatting and code clean up.
+	* exp_ch6.adb (Expand_Actuals): Generate predicate test
+	unconditionally for case of OUT or IN OUT actual (before this
+	was generated only for certain subcases, which is wrong, the
+	test is always needed).
+
 2014-07-29  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch3.adb: Move Has_Defaulted_Discriminants to sem_util.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index de2ded83fd6..724e82ae8d9 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1743,10 +1743,6 @@ package body Exp_Ch6 is
             --  be handled separately because the name does not denote an
             --  overloadable entity.
 
-            --  If the formal is class-wide the corresponding postcondition
-            --  procedure does not include a predicate call, so it has to be
-            --  generated explicitly.
-
             if not Is_Init_Proc (Subp)
               and then (Has_Aspect (E_Actual, Aspect_Predicate)
                           or else
@@ -1755,21 +1751,8 @@ package body Exp_Ch6 is
                         Has_Aspect (E_Actual, Aspect_Static_Predicate))
               and then Present (Predicate_Function (E_Actual))
             then
-               if Is_Entity_Name (Actual)
-                 or else
-                   (Is_Derived_Type (E_Actual)
-                     and then Is_Overloadable (Subp)
-                     and then Is_Inherited_Operation_For_Type (Subp, E_Actual))
-               then
-                  Append_To (Post_Call,
-                    Make_Predicate_Check (E_Actual, Actual));
-
-               elsif Is_Class_Wide_Type (E_Formal)
-                 and then not Is_Class_Wide_Type (E_Actual)
-               then
-                  Append_To (Post_Call,
-                    Make_Predicate_Check (E_Actual, Actual));
-               end if;
+               Append_To (Post_Call,
+                 Make_Predicate_Check (E_Actual, Actual));
             end if;
 
          --  Processing for IN parameters
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index 8d59e6ceeee..292cab1339d 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -71,6 +71,39 @@ procedure Frontend is
    Config_Pragmas : List_Id;
    --  Gather configuration pragmas
 
+   function Need_To_Be_In_The_Dependencies (Pragma_List : List_Id)
+     return Boolean;
+   --  Check if a configuration pragmas file that contains the Pragma_List
+   --  should be a dependency for the source being compiled. Returns
+   --  False if Pragma_List is Error_List or contains only pragmas
+   --  Source_File_Name_Project, returns True otherwise.
+
+   ------------------------------------
+   -- Need_To_Be_In_The_Dependencies --
+   ------------------------------------
+
+   function Need_To_Be_In_The_Dependencies (Pragma_List : List_Id)
+     return Boolean
+   is
+      Prag  : Node_Id;
+      Pname : Name_Id;
+   begin
+      if Pragma_List /= Error_List then
+         Prag := First (Pragma_List);
+         while Present (Prag) loop
+            Pname := Pragma_Name (Prag);
+
+            if Pname /= Name_Source_File_Name_Project then
+               return True;
+            end if;
+
+            Next (Prag);
+         end loop;
+      end if;
+
+      return False;
+   end Need_To_Be_In_The_Dependencies;
+
 begin
    --  Carry out package initializations. These are initializations which might
    --  logically be performed at elaboration time, were it not for the fact
@@ -144,8 +177,6 @@ begin
 
       Prag : Node_Id;
 
-      Temp_File : Boolean;
-
    begin
       --  We always analyze config files with style checks off, since
       --  we don't want a miscellaneous gnat.adc that is around to
@@ -166,10 +197,23 @@ begin
          Name_Len := 8;
          Source_gnat_adc := Load_Config_File (Name_Enter);
 
+         --  Case of gnat.adc file present
+
          if Source_gnat_adc /= No_Source_File then
+
+            --  Parse the gnat.adc file for configuration pragmas
+
             Initialize_Scanner (No_Unit, Source_gnat_adc);
             Config_Pragmas := Par (Configuration_Pragmas => True);
+
+            --  We unconditionally add a compilation dependency for gnat.adc
+            --  so that if it changes, we force a recompilation. This is a
+            --  fairly recent (2014-03-28) change.
+
             Prepcomp.Add_Dependency (Source_gnat_adc);
+
+         --  Case of no gnat.adc file present
+
          else
             Config_Pragmas := Empty_List;
          end if;
@@ -196,15 +240,17 @@ begin
       --  Now deal with specified config pragmas files if there are any
 
       if Opt.Config_File_Names /= null then
+
+         --  Loop through config pragmas files
+
          for Index in Opt.Config_File_Names'Range loop
+
+            --  See if extension is .TMP/.tmp indicating a temporary config
+            --  file (which we ignore from the dependency point of view).
+
             Name_Len := Config_File_Names (Index)'Length;
             Name_Buffer (1 .. Name_Len) := Config_File_Names (Index).all;
-            Temp_File :=
-              Name_Len > 4
-              and then
-                (Name_Buffer (Name_Len - 3 .. Name_Len) = ".TMP"
-                 or else
-                 Name_Buffer (Name_Len - 3 .. Name_Len) = ".tmp");
+            --  Load the file, error if we did not find it
 
             Source_Config_File := Load_Config_File (Name_Enter);
 
@@ -213,13 +259,29 @@ begin
                  ("cannot find configuration pragmas file "
                   & Config_File_Names (Index).all);
 
-            elsif not Temp_File then
-               Prepcomp.Add_Dependency (Source_Config_File);
+            --  If we did find the file, and it contains pragmas other than
+            --  Source_File_Name_Project, then we unconditionally add a
+            --  compilation dependency for it so that if it changes, we force
+            --  a recompilation. This is a fairly recent (2014-03-28) change.
+
+            else
+
+               --  Parse the config pragmas file, and accumulate results
+
+               Initialize_Scanner (No_Unit, Source_Config_File);
+
+               declare
+                  Pragma_List : constant List_Id :=
+                    Par (Configuration_Pragmas => True);
+               begin
+                  if Need_To_Be_In_The_Dependencies (Pragma_List) then
+                     Prepcomp.Add_Dependency (Source_Config_File);
+                  end if;
+
+                  Append_List_To (Config_Pragmas, Pragma_List);
+               end;
             end if;
 
-            Initialize_Scanner (No_Unit, Source_Config_File);
-            Append_List_To
-              (Config_Pragmas, Par (Configuration_Pragmas => True));
          end loop;
       end if;
 
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index dda78d6a256..4e7f8f96fbf 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -1499,12 +1499,12 @@ package body Inline is
       --------------------------
 
       function In_Some_Private_Part (N : Node_Id) return Boolean is
-         P  : Node_Id := N;
+         P  : Node_Id;
          PP : Node_Id;
+
       begin
-         while Present (P)
-           and then Present (Parent (P))
-         loop
+         P := N;
+         while Present (P) and then Present (Parent (P)) loop
             PP := Parent (P);
 
             if Nkind (PP) = N_Package_Specification
@@ -1515,6 +1515,7 @@ package body Inline is
 
             P := PP;
          end loop;
+
          return False;
       end In_Some_Private_Part;
 
@@ -1541,6 +1542,8 @@ package body Inline is
          return Nkind (Original_Node (Decl)) = N_Expression_Function;
       end Is_Expression_Function;
 
+      --  Local declarations
+
       Id : Entity_Id;  --  Procedure or function entity for the subprogram
 
    --  Start of Can_Be_Inlined_In_GNATprove_Mode
@@ -2162,9 +2165,10 @@ package body Inline is
                           or else Has_Pragma_Inline_Always (Spec_Id)
                           or else (Has_Pragma_Inline (Spec_Id)
                                     and then ((Optimization_Level > 0
-                                                and then Ekind (Spec_Id)
-                                                             = E_Function)
+                                                and then Ekind (Spec_Id) =
+                                                                   E_Function)
                                                or else Front_End_Inlining));
+
          Body_To_Analyze : Node_Id;
 
       --  Start of processing for Check_Body_To_Inline
diff --git a/gcc/ada/prepcomp.ads b/gcc/ada/prepcomp.ads
index ea132ffea4c..20a69bfbd4c 100644
--- a/gcc/ada/prepcomp.ads
+++ b/gcc/ada/prepcomp.ads
@@ -31,10 +31,9 @@ with Types; use Types;
 package Prepcomp is
 
    procedure Add_Dependency (S : Source_File_Index);
-   --  Add a dependency on a non-source file.
-   --  This is used internally for the preprocessing data file and the
-   --  preprocessing definition file, and also externally for non-temporary
-   --  configuration pragmas files.
+   --  Add a dependency on a non-source file. This is used internally for the
+   --  preprocessing data file and the preprocessing definition file, and also
+   --  externally for non-temporary configuration pragmas files.
 
    procedure Add_Dependencies;
    --  Add dependencies on the preprocessing data file and the preprocessing
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index c0ae52d11bf..e8051e7dce2 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -2978,7 +2978,7 @@ package body Sem_Res is
 
       procedure Check_Aliased_Parameter;
       --  Check rules on aliased parameters and related accessibility rules
-      --  in (3.10.2 (10.2-10.4)).
+      --  in (RM 3.10.2 (10.2-10.4)).
 
       procedure Check_Argument_Order;
       --  Performs a check for the case where the actuals are all simple
@@ -3050,12 +3050,12 @@ package body Sem_Res is
 
                else
                   Error_Msg_NE ("untagged actual does not match "
-                    & "aliased formal&", A, F);
+                                & "aliased formal&", A, F);
                end if;
 
             else
                Error_Msg_NE ("actual for aliased formal& must be "
-                 & "aliased object", A, F);
+                             & "aliased object", A, F);
             end if;
 
             if Ekind (Nam) = E_Procedure then
@@ -3063,19 +3063,19 @@ package body Sem_Res is
 
             elsif Ekind (Etype (Nam)) = E_Anonymous_Access_Type then
                if Nkind (Parent (N)) = N_Type_Conversion
-                 and then Type_Access_Level (Etype (Parent (N)))
-                   < Object_Access_Level (A)
+                 and then Type_Access_Level (Etype (Parent (N))) <
+                                                        Object_Access_Level (A)
                then
                   Error_Msg_N ("aliased actual has wrong accessibility", A);
                end if;
 
             elsif Nkind (Parent (N)) = N_Qualified_Expression
               and then Nkind (Parent (Parent (N))) = N_Allocator
-              and then Type_Access_Level (Etype (Parent (Parent (N))))
-                < Object_Access_Level (A)
+              and then Type_Access_Level (Etype (Parent (Parent (N)))) <
+                                                        Object_Access_Level (A)
             then
                Error_Msg_N
-                 ("Aliased actual in allocator has wrong accessibility", A);
+                 ("aliased actual in allocator has wrong accessibility", A);
             end if;
          end if;
       end Check_Aliased_Parameter;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c1d7581121c..fd7fbea627a 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -7345,8 +7345,8 @@ package body Sem_Util is
    begin
       return Has_Discriminants (Typ)
        and then Present (First_Discriminant (Typ))
-       and then Present
-         (Discriminant_Default_Value (First_Discriminant (Typ)));
+       and then Present (Discriminant_Default_Value
+                           (First_Discriminant (Typ)));
    end Has_Defaulted_Discriminants;
 
    -------------------