[multiple changes]

2014-07-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Replace_Type_References_Generic): Use type entity
	as a parameter, rather than its Chars field, in order to locate
	freeze node of type. If the predicate or invariant has references
	to types other than the one to which the contract applies, these
	types must be frozen, and the corresponding predicate functions
	created, before that freeze node.

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

	* freeze.adb, einfo.ads, einfo.adb: Minor code reorganization.
	* par_sco.adb: Minor reformatting.

2014-07-18  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch4.adb (Real_Range_Check): Turn off
	the Do_Range_Check flag on the conversion's current Expression
	argument rather than on the originally captured Operand node,
	as Expression may reflect a rewriting (as in conversions to a
	fixed-point type).

2014-07-18  Vincent Celier  <celier@adacore.com>

	* ali.adb (Scan_ALI): Set Sdep_Record.Unit_Name, when the unit
	is not a subunit.
	* ali.ads (Sdep_Record): New component Unit_Name.
	* lib-writ.adb (Write_ALI): Write the unit name in D lines.
	* makeutl.adb (Check_Source_Info_In_ALI): Return False if a
	dependent unit is in a project and the source file name is not
	one of its sources.

From-SVN: r212795

11 files changed, 113 insertions, 42 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 80c3358..f69a570 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,35 @@
+2014-07-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Replace_Type_References_Generic): Use type entity
+	as a parameter, rather than its Chars field, in order to locate
+	freeze node of type. If the predicate or invariant has references
+	to types other than the one to which the contract applies, these
+	types must be frozen, and the corresponding predicate functions
+	created, before that freeze node.
+
+2014-07-18  Robert Dewar  <dewar@adacore.com>
+
+	* freeze.adb, einfo.ads, einfo.adb: Minor code reorganization.
+	* par_sco.adb: Minor reformatting.
+
+2014-07-18  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_ch4.adb (Real_Range_Check): Turn off
+	the Do_Range_Check flag on the conversion's current Expression
+	argument rather than on the originally captured Operand node,
+	as Expression may reflect a rewriting (as in conversions to a
+	fixed-point type).
+
+2014-07-18  Vincent Celier  <celier@adacore.com>
+
+	* ali.adb (Scan_ALI): Set Sdep_Record.Unit_Name, when the unit
+	is not a subunit.
+	* ali.ads (Sdep_Record): New component Unit_Name.
+	* lib-writ.adb (Write_ALI): Write the unit name in D lines.
+	* makeutl.adb (Check_Source_Info_In_ALI): Return False if a
+	dependent unit is in a project and the source file name is not
+	one of its sources.
+
 2014-07-18  Bob Duff  <duff@adacore.com>
 
 	* s-addima.ads: Minor: add comment.
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index b90c5c0..73db0e8 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -2317,9 +2317,10 @@ package body ALI is
                end if;
             end;
 
-            --  Acquire subunit and reference file name entries
+            --  Acquire (sub)unit and reference file name entries
 
             Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
+            Sdep.Table (Sdep.Last).Unit_Name    := No_Name;
             Sdep.Table (Sdep.Last).Rfile        :=
               Sdep.Table (Sdep.Last).Sfile;
             Sdep.Table (Sdep.Last).Start_Line   := 1;
@@ -2327,7 +2328,7 @@ package body ALI is
             if not At_Eol then
                Skip_Space;
 
-               --  Here for subunit name
+               --  Here for (sub)unit name
 
                if Nextc not in '0' .. '9' then
                   Name_Len := 0;
@@ -2335,11 +2336,18 @@ package body ALI is
                      Add_Char_To_Name_Buffer (Getc);
                   end loop;
 
-                  --  Set the subunit name. Note that we use Name_Find rather
+                  --  Set the (sub)unit name. Note that we use Name_Find rather
                   --  than Name_Enter here as the subunit name may already
                   --  have been put in the name table by the Project Manager.
 
-                  Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
+                  if Name_Len <= 2
+                    or else Name_Buffer (Name_Len - 1) /= '%'
+                  then
+                     Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
+                  else
+                     Name_Len := Name_Len - 2;
+                     Sdep.Table (Sdep.Last).Unit_Name := Name_Find;
+                  end if;
 
                   Skip_Space;
                end if;
diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads
index 1d7e159..be5f793 100644
--- a/gcc/ada/ali.ads
+++ b/gcc/ada/ali.ads
@@ -767,6 +767,9 @@ package ALI is
       Subunit_Name : Name_Id;
       --  Name_Id for subunit name if present, else No_Name
 
+      Unit_Name : Name_Id;
+      --  Name_Id for the unit name, if not a subunit. No_Name for a subunit.
+
       Rfile : File_Name_Type;
       --  Reference file name. Same as Sfile unless a Source_Reference pragma
       --  was used, in which case it reflects the name used in the pragma.
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 79da6f9..a2abb45 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -7017,6 +7017,15 @@ package body Einfo is
         Ekind (Id) = E_Abstract_State and then Nkind (Parent (Id)) = N_Null;
    end Is_Null_State;
 
+   ---------------------
+   -- Is_Packed_Array --
+   ---------------------
+
+   function Is_Packed_Array (Id : E) return B is
+   begin
+      return Is_Array_Type (Id) and then Is_Packed (Id);
+   end Is_Packed_Array;
+
    -----------------------------------
    -- Is_Package_Or_Generic_Package --
    -----------------------------------
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 011e10c..42439ad 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2703,6 +2703,9 @@ package Einfo is
 --       out that the component size is not suitable for bit packing, the
 --       Is_Packed flag gets turned off.
 
+--    Is_Packed_Array (synth)
+--       Applies to all entities, true if entity is for a packed array.
+
 --    Is_Packed_Array_Type (Flag138)
 --       Defined in all entities. This flag is set on the entity for the type
 --       used to implement a packed array (either a modular type, or a subtype
@@ -6874,6 +6877,7 @@ package Einfo is
    function Is_Ghost_Subprogram                 (Id : E) return B;
    function Is_Null_State                       (Id : E) return B;
    function Is_Package_Or_Generic_Package       (Id : E) return B;
+   function Is_Packed_Array                     (Id : E) return B;
    function Is_Prival                           (Id : E) return B;
    function Is_Protected_Component              (Id : E) return B;
    function Is_Protected_Interface              (Id : E) return B;
@@ -8634,6 +8638,7 @@ package Einfo is
    pragma Inline (Base_Type);
    pragma Inline (Is_Base_Type);
    pragma Inline (Is_Package_Or_Generic_Package);
+   pragma Inline (Is_Packed_Array);
    pragma Inline (Is_Volatile);
    pragma Inline (Is_Wrapper_Package);
    pragma Inline (Known_RM_Size);
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 917f98a..725efab 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -10191,7 +10191,13 @@ package body Exp_Ch4 is
                     and then S_Lov >= D_Lov
                     and then S_Hiv <= D_Hiv
                   then
-                     Set_Do_Range_Check (Operand, False);
+                     --  Unset the range check flag on the current value of
+                     --  Expression (N), since the captured Operand may have
+                     --  been rewritten (such as for the case of a conversion
+                     --  to a fixed-point type).
+
+                     Set_Do_Range_Check (Expression (N), False);
+
                      return;
                   end if;
                end;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index ab0334e..fb35942 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1095,20 +1095,6 @@ package body Freeze is
 
       Component_Aliased : Boolean;
 
-      function Is_Packed_Array (T : Entity_Id) return Boolean;
-      --  True for a packed array type
-
-      ---------------------
-      -- Is_Packed_Array --
-      ---------------------
-
-      function Is_Packed_Array (T : Entity_Id) return Boolean is
-      begin
-         return Is_Array_Type (T) and then Is_Packed (T);
-      end Is_Packed_Array;
-
-   --  Start of processing for Check_Component_Storage_Order
-
    begin
       --  Record case
 
@@ -1121,10 +1107,9 @@ package body Freeze is
             Component_Aliased := False;
 
          else
-            --  If a component clause is present, check whether component
-            --  starts on a storage element boundary. Otherwise conservatively
-            --  assume it does so only in the case where the record is not
-            --  packed.
+            --  If a component clause is present, check if the component starts
+            --  on a storage element boundary. Otherwise conservatively assume
+            --  it does so only in the case where the record is not packed.
 
             if Present (Component_Clause (Comp)) then
                Comp_Byte_Aligned :=
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index df57c65..1240032 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -1429,12 +1429,15 @@ package body Lib.Writ is
 
                --  If subunit, add unit name, omitting the %b at the end
 
-               if Present (Cunit (Unum))
-                 and then Nkind (Unit (Cunit (Unum))) = N_Subunit
-               then
+               if Present (Cunit (Unum)) then
                   Get_Decoded_Name_String (Unit_Name (Unum));
                   Write_Info_Char (' ');
-                  Write_Info_Str (Name_Buffer (1 .. Name_Len - 2));
+
+                  if Nkind (Unit (Cunit (Unum))) = N_Subunit then
+                     Write_Info_Str (Name_Buffer (1 .. Name_Len - 2));
+                  else
+                     Write_Info_Str (Name_Buffer (1 .. Name_Len));
+                  end if;
                end if;
 
                --  If Source_Reference pragma used, output information
diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb
index 4518959..36b1c6a 100644
--- a/gcc/ada/makeutl.adb
+++ b/gcc/ada/makeutl.adb
@@ -320,6 +320,15 @@ package body Makeutl is
                   end;
                end if;
 
+               Unit_Name := SD.Unit_Name;
+
+               if Unit_Name /= No_Name
+                 and then not Fname.Is_Internal_File_Name (SD.Sfile)
+                 and then File_Not_A_Source_Of (Tree, Unit_Name, SD.Sfile)
+               then
+                  return No_Name;
+               end if;
+
             else
                --  For separates, the file is no longer associated with the
                --  unit ("proc-sep.adb" is not associated with unit "proc.sep")
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index 215a81a..15382ac 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -308,8 +308,8 @@ package body Par_SCO is
 
       function Check_Node (N : Node_Id) return Traverse_Result;
       --  Determine if Nkind (N) indicates the presence of a decision (i.e.
-      --  N is a logical operator -- a decision in itelsf -- or an
-      --  IF-expression -- whose Condition attribute is a decision).
+      --  N is a logical operator, which is a decision in itself, or an
+      --  IF-expression whose Condition attribute is a decision).
 
       ----------------
       -- Check_Node --
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 317510a..fe54f88 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -33,6 +33,7 @@ with Errout;   use Errout;
 with Exp_Disp; use Exp_Disp;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
+with Freeze;   use Freeze;
 with Lib;      use Lib;
 with Lib.Xref; use Lib.Xref;
 with Namet;    use Namet;
@@ -155,14 +156,14 @@ package body Sem_Ch13 is
 
    generic
       with procedure Replace_Type_Reference (N : Node_Id);
-   procedure Replace_Type_References_Generic (N : Node_Id; TName : Name_Id);
+   procedure Replace_Type_References_Generic (N : Node_Id; T : Entity_Id);
    --  This is used to scan an expression for a predicate or invariant aspect
-   --  replacing occurrences of the name TName (the name of the subtype to
-   --  which the aspect applies) with appropriate references to the parameter
-   --  of the predicate function or invariant procedure. The procedure passed
-   --  as a generic parameter does the actual replacement of node N, which is
-   --  either a simple direct reference to TName, or a selected component that
-   --  represents an appropriately qualified occurrence of TName.
+   --  replacing occurrences of the name of the subtype to which the aspect
+   --  applies with appropriate references to the parameter of the predicate
+   --  function or invariant procedure. The procedure passed as a generic
+   --  parameter does the actual replacement of node N, which is either a
+   --  simple direct reference to T, or a selected component that represents
+   --  an appropriately qualified occurrence of T.
 
    procedure Resolve_Iterable_Operation
      (N      : Node_Id;
@@ -7216,7 +7217,7 @@ package body Sem_Ch13 is
                --  with references to the object, converted to type'Class in
                --  the case of Invariant'Class aspects.
 
-               Replace_Type_References (Exp, Chars (T));
+               Replace_Type_References (Exp, T);
 
                --  If this invariant comes from an aspect, find the aspect
                --  specification, and replace the saved expression because
@@ -7268,7 +7269,7 @@ package body Sem_Ch13 is
                      Inv : constant Node_Id :=
                              Expression (Corresponding_Aspect (Ritem));
                   begin
-                     Replace_Type_References (Inv, Chars (T));
+                     Replace_Type_References (Inv, T);
                      Preanalyze_Assert_Expression (Inv, Standard_Boolean);
                   end;
                end if;
@@ -7656,7 +7657,7 @@ package body Sem_Ch13 is
                   --  We need to replace any occurrences of the name of the
                   --  type with references to the object.
 
-                  Replace_Type_References (Arg2, Chars (Typ));
+                  Replace_Type_References (Arg2, Typ);
 
                   --  If this predicate comes from an aspect, find the aspect
                   --  specification, and replace the saved expression because
@@ -10303,7 +10304,7 @@ package body Sem_Ch13 is
       Replace (N, Make_Null_Statement (Sloc (N)));
 
       --  The null statement must be marked as not coming from source. This is
-      --  so that ASIS ignores if, and also the back end does not expect bogus
+      --  so that ASIS ignores it, and also the back end does not expect bogus
       --  "from source" null statements in weird places (e.g. in declarative
       --  regions where such null statements are not allowed).
 
@@ -10837,7 +10838,8 @@ package body Sem_Ch13 is
    -- Replace_Type_References_Generic --
    -------------------------------------
 
-   procedure Replace_Type_References_Generic (N : Node_Id; TName : Name_Id) is
+   procedure Replace_Type_References_Generic (N : Node_Id; T : Entity_Id) is
+      TName : constant Name_Id := Chars (T);
 
       function Replace_Node (N : Node_Id) return Traverse_Result;
       --  Processes a single node in the traversal procedure below, checking
@@ -10859,9 +10861,18 @@ package body Sem_Ch13 is
 
          if Nkind (N) = N_Identifier then
 
-            --  If not the type name, all done with this node
+            --  If not the type name, check whether it is a reference to
+            --  some other type, which must be frozen before the predicate
+            --  function is analyzed, i.e. before the freeze node of the
+            --  type to which the predicate applies.
 
             if Chars (N) /= TName then
+               if Present (Current_Entity (N))
+                  and then Is_Type (Current_Entity (N))
+               then
+                  Freeze_Before (Freeze_Node (T), Current_Entity (N));
+               end if;
+
                return Skip;
 
             --  Otherwise do the replacement and we are done with this node