[multiple changes]

2009-07-11  Thomas Quinot  <quinot@adacore.com>

	* sem_util.adb, sem_res.adb, sem_warn.adb: Minor comment editing:
	Lvalue -> lvalue

	* exp_ch6.adb: Minor reformatting

2009-07-11  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Expand_Atomic_Aggregate): Clean up code, take into
	account possible type qualification to determine whether aggregate
	needs a target temporary to respect atomic type or object.

	* exp_aggr.adb (Expand_Record_Aggregate): Use new version of
	Expand_Atomic_Aggregate.

2009-07-11  Emmanuel Briot  <briot@adacore.com>

	* prj.adb, prj.ads, prj-nmsc.adb (Mark_Excluded_Sources): Speed up
	algorithm.
	(Excluded_Sources_Htable): No longer a global table.
	Change error message to indicate which files are illegal in the list
	of excluded files, as opposed to only the location in the project
	file.
	(Find_Source): New subprogram.

From-SVN: r149515

gcc/ada/ChangeLog

+2009-07-11  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_util.adb, sem_res.adb, sem_warn.adb: Minor comment editing:
+	Lvalue -> lvalue
+
+	* exp_ch6.adb: Minor reformatting
+
+2009-07-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* freeze.adb (Expand_Atomic_Aggregate): Clean up code, take into
+	account possible type qualification to determine whether aggregate
+	needs a target temporary to respect atomic type or object.
+
+	* exp_aggr.adb (Expand_Record_Aggregate): Use new version of
+	Expand_Atomic_Aggregate.
+
+2009-07-11  Emmanuel Briot  <briot@adacore.com>
+
+	* prj.adb, prj.ads, prj-nmsc.adb (Mark_Excluded_Sources): Speed up
+	algorithm.
+	(Excluded_Sources_Htable): No longer a global table.
+	Change error message to indicate which files are illegal in the list
+	of excluded files, as opposed to only the location in the project
+	file.
+	(Find_Source): New subprogram.
+
 2009-07-10  Thomas Quinot  <quinot@adacore.com>
 
 	* exp_ch7.adb: Update comments.

gcc/ada/exp_aggr.adb

@@ -5475,11 +5475,9 @@ package body Exp_Aggr is
       --  an atomic move for it.
 
       if Is_Atomic (Typ)
-        and then Nkind_In (Parent (N), N_Object_Declaration,
-                                       N_Assignment_Statement)
         and then Comes_From_Source (Parent (N))
+        and then Expand_Atomic_Aggregate (N, Typ)
       then
-         Expand_Atomic_Aggregate (N, Typ);
          return;
 
       --  No special management required for aggregates used to initialize

gcc/ada/freeze.adb

@@ -1115,15 +1115,27 @@ package body Freeze is
    -- Expand_Atomic_Aggregate --
    -----------------------------
 
-   procedure Expand_Atomic_Aggregate (E : Entity_Id; Typ : Entity_Id) is
+   function  Expand_Atomic_Aggregate
+     (E   : Entity_Id;
+      Typ : Entity_Id) return Boolean
+   is
       Loc   : constant Source_Ptr := Sloc (E);
       New_N : Node_Id;
+      Par   : Node_Id;
       Temp  : Entity_Id;
 
    begin
-      if (Nkind (Parent (E)) = N_Object_Declaration
-            or else Nkind (Parent (E)) = N_Assignment_Statement)
-        and then Comes_From_Source (Parent (E))
+      Par := Parent (E);
+
+      --  Array may be qualified, so find outer context.
+
+      if Nkind (Par) = N_Qualified_Expression then
+         Par := Parent (Par);
+      end if;
+
+      if (Nkind (Par) = N_Object_Declaration
+            or else Nkind (Par) = N_Assignment_Statement)
+        and then Comes_From_Source (Par)
       then
          Temp :=
            Make_Defining_Identifier (Loc,
@@ -1134,11 +1146,14 @@ package body Freeze is
              Defining_Identifier => Temp,
              Object_Definition   => New_Occurrence_Of (Typ, Loc),
              Expression          => Relocate_Node (E));
-         Insert_Before (Parent (E), New_N);
+         Insert_Before (Par, New_N);
          Analyze (New_N);
 
-         Set_Expression (Parent (E), New_Occurrence_Of (Temp, Loc));
+         Set_Expression (Par, New_Occurrence_Of (Temp, Loc));
+         return True;
 
+      else
+         return False;
       end if;
    end Expand_Atomic_Aggregate;
 
@@ -2351,8 +2366,10 @@ package body Freeze is
            and then Nkind (Parent (E)) = N_Object_Declaration
            and then Present (Expression (Parent (E)))
            and then Nkind (Expression (Parent (E))) = N_Aggregate
+           and then
+            Expand_Atomic_Aggregate (Expression (Parent (E)), Etype (E))
          then
-            Expand_Atomic_Aggregate (Expression (Parent (E)), Etype (E));
+            null;
          end if;
 
          --  For a subprogram, freeze all parameter types and also the return

gcc/ada/freeze.ads

@@ -175,12 +175,17 @@ package Freeze is
    --  do not allow a size clause if the size would not otherwise be known at
    --  compile time in any case.
 
-   procedure Expand_Atomic_Aggregate (E : Entity_Id; Typ : Entity_Id);
+   function  Expand_Atomic_Aggregate
+     (E   : Entity_Id;
+      Typ : Entity_Id) return Boolean;
+
    --  If an atomic object is initialized with an aggregate or is assigned
    --  an aggregate, we have to prevent a piecemeal access or assignment
    --  to the object, even if the aggregate is to be expanded. We create
    --  a temporary for the aggregate, and assign the temporary instead,
-   --  so that the back end can generate an atomic move for it.
+   --  so that the back end can generate an atomic move for it. This is
+   --  only done in the context of an object declaration or an assignment.
+   --  Function is a noop and returns false in other contexts.
 
    function Freeze_Entity (E : Entity_Id; Loc : Source_Ptr) return List_Id;
    --  Freeze an entity, and return Freeze nodes, to be inserted at the

gcc/ada/prj-nmsc.adb

@@ -181,7 +181,7 @@ package body Prj.Nmsc is
    No_File_Found : constant File_Found := (No_File, False, No_Location);
    --  Comments needed ???
 
-   package Excluded_Sources_Htable is new GNAT.HTable.Simple_HTable
+   package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
      (Header_Num => Header_Num,
       Element    => File_Found,
       No_Element => No_File_Found,
@@ -193,7 +193,8 @@ package body Prj.Nmsc is
 
    procedure Find_Excluded_Sources
      (Project  : Project_Id;
-      In_Tree : Project_Tree_Ref);
+      In_Tree  : Project_Tree_Ref;
+      Excluded : in out Excluded_Sources_Htable.Instance);
    --  Find the list of files that should not be considered as source files
    --  for this project. Sets the list in the Excluded_Sources_Htable.
 
@@ -225,7 +226,8 @@ package body Prj.Nmsc is
 
    procedure Load_Naming_Exceptions
      (Project  : Project_Id;
-      In_Tree : Project_Tree_Ref);
+      In_Tree  : Project_Tree_Ref;
+      Excluded : in out Excluded_Sources_Htable.Instance);
    --  All source files in Data.First_Source are considered as naming
    --  exceptions, and copied into the Source_Names and Unit_Exceptions tables
    --  as appropriate.
@@ -378,7 +380,8 @@ package body Prj.Nmsc is
      (Project                   : Project_Id;
       In_Tree                   : Project_Tree_Ref;
       For_All_Sources           : Boolean;
-      Allow_Duplicate_Basenames : Boolean);
+      Allow_Duplicate_Basenames : Boolean;
+      Excluded                  : in out Excluded_Sources_Htable.Instance);
    --  Search the source directories to find the sources. If For_All_Sources is
    --  True, check each regular file name against the naming schemes of the
    --  different languages. Otherwise consider only the file names in the hash
@@ -462,7 +465,8 @@ package body Prj.Nmsc is
      (Project   : Project_Id;
       In_Tree   : Project_Tree_Ref;
       Proc_Data : in out Processing_Data;
-      Allow_Duplicate_Basenames : Boolean);
+      Allow_Duplicate_Basenames : Boolean;
+      Excluded                  : in out Excluded_Sources_Htable.Instance);
    --  Process the Source_Files and Source_List_File attributes, and store the
    --  list of source files into the Source_Names htable. When these attributes
    --  are not defined, find all files matching the naming schemes in the
@@ -6574,7 +6578,8 @@ package body Prj.Nmsc is
 
    procedure Find_Excluded_Sources
      (Project  : Project_Id;
-      In_Tree : Project_Tree_Ref)
+      In_Tree  : Project_Tree_Ref;
+      Excluded : in out Excluded_Sources_Htable.Instance)
    is
       Excluded_Source_List_File : constant Variable_Value :=
                                     Util.Value_Of
@@ -6606,7 +6611,7 @@ package body Prj.Nmsc is
              (Name_Locally_Removed_Files, Project.Decl.Attributes, In_Tree);
       end if;
 
-      Excluded_Sources_Htable.Reset;
+      Excluded_Sources_Htable.Reset (Excluded);
 
       --  If there are excluded sources, put them in the table
 
@@ -6641,7 +6646,8 @@ package body Prj.Nmsc is
                Location := Element.Location;
             end if;
 
-            Excluded_Sources_Htable.Set (Name, (Name, False, Location));
+            Excluded_Sources_Htable.Set
+              (Excluded, Name, (Name, False, Location));
             Current := Element.Next;
          end loop;
 
@@ -6706,7 +6712,7 @@ package body Prj.Nmsc is
                         end loop;
 
                         Excluded_Sources_Htable.Set
-                          (Name, (Name, False, Location));
+                          (Excluded, Name, (Name, False, Location));
                      end if;
                   end loop;
 
@@ -6725,7 +6731,8 @@ package body Prj.Nmsc is
      (Project                   : Project_Id;
       In_Tree                   : Project_Tree_Ref;
       Proc_Data                 : in out Processing_Data;
-      Allow_Duplicate_Basenames : Boolean)
+      Allow_Duplicate_Basenames : Boolean;
+      Excluded                  : in out Excluded_Sources_Htable.Instance)
    is
       Sources : constant Variable_Value :=
                   Util.Value_Of
@@ -6894,7 +6901,8 @@ package body Prj.Nmsc is
            (Project, In_Tree,
             For_All_Sources           =>
               Sources.Default and then Source_List_File.Default,
-            Allow_Duplicate_Basenames => Allow_Duplicate_Basenames);
+            Allow_Duplicate_Basenames => Allow_Duplicate_Basenames,
+            Excluded                  => Excluded);
       end if;
 
       --  Check if all exceptions have been found. For Ada, it is an error if
@@ -7548,7 +7556,8 @@ package body Prj.Nmsc is
      (Project                   : Project_Id;
       In_Tree                   : Project_Tree_Ref;
       For_All_Sources           : Boolean;
-      Allow_Duplicate_Basenames : Boolean)
+      Allow_Duplicate_Basenames : Boolean;
+      Excluded                  : in out Excluded_Sources_Htable.Instance)
    is
       Source_Dir        : String_List_Id;
       Element           : String_Element;
@@ -7633,8 +7642,8 @@ package body Prj.Nmsc is
                            --  Case_Sensitive set True (no folding)
 
                            Path : Path_Name_Type;
-                           FF   : File_Found :=
-                                    Excluded_Sources_Htable.Get (File_Name);
+                           FF   : File_Found := Excluded_Sources_Htable.Get
+                                                  (Excluded, File_Name);
 
                         begin
                            Name_Len := Path_Name'Length;
@@ -7644,7 +7653,8 @@ package body Prj.Nmsc is
                            if FF /= No_File_Found then
                               if not FF.Found then
                                  FF.Found := True;
-                                 Excluded_Sources_Htable.Set (File_Name, FF);
+                                 Excluded_Sources_Htable.Set
+                                   (Excluded, File_Name, FF);
 
                                  if Current_Verbosity = High then
                                     Write_Str ("     excluded source """);
@@ -7692,7 +7702,8 @@ package body Prj.Nmsc is
 
    procedure Load_Naming_Exceptions
      (Project  : Project_Id;
-      In_Tree : Project_Tree_Ref)
+      In_Tree  : Project_Tree_Ref;
+      Excluded : in out Excluded_Sources_Htable.Instance)
    is
       Source : Source_Id;
       Iter   : Source_Iterator;
@@ -7707,7 +7718,9 @@ package body Prj.Nmsc is
 
          --  An excluded file cannot also be an exception file name
 
-         if Excluded_Sources_Htable.Get (Source.File) /= No_File_Found then
+         if Excluded_Sources_Htable.Get (Excluded, Source.File) /=
+           No_File_Found
+         then
             Error_Msg_File_1 := Source.File;
             Error_Msg
               (Project, In_Tree,
@@ -7765,6 +7778,8 @@ package body Prj.Nmsc is
       Allow_Duplicate_Basenames : Boolean)
    is
       Iter     : Source_Iterator;
+      Src      : Source_Id;
+      Excluded_Sources : Excluded_Sources_Htable.Instance;
 
       procedure Process_Sources_In_Multi_Language_Mode;
       --  Find all source files when in multi language mode
@@ -7778,28 +7793,18 @@ package body Prj.Nmsc is
 
       procedure Mark_Excluded_Sources is
          Source   : Source_Id := No_Source;
-         OK       : Boolean;
          Excluded : File_Found;
-
+         Proj     : Project_Id;
       begin
-         Excluded := Excluded_Sources_Htable.Get_First;
-         while Excluded /= No_File_Found loop
-            OK := False;
-
-            --  ??? Don't we have a hash table to map files to Source_Id?
-            --  ??? Why can't simply iterate over the sources of the current
-            --  project, as opposed to the whole tree ?
-
-            Iter := For_Each_Source (In_Tree);
-            loop
+         Proj := Project;
+         while Proj /= No_Project loop
+            Iter := For_Each_Source (In_Tree, Proj);
+            while Prj.Element (Iter) /= No_Source loop
                Source   := Prj.Element (Iter);
-               exit when Source = No_Source;
+               Excluded := Excluded_Sources_Htable.Get
+                 (Excluded_Sources, Source.File);
 
-               if Source.File = Excluded.File then
-                  if Source.Project = Project
-                    or else Is_Extending (Project, Source.Project)
-                  then
-                     OK := True;
+               if Excluded /= No_File_Found then
                   Source.Locally_Removed := True;
                   Source.In_Interfaces   := False;
 
@@ -7810,37 +7815,44 @@ package body Prj.Nmsc is
                         & " " & Get_Name_String (Source.Project.Name));
                   end if;
 
-                  else
-                     Error_Msg
-                       (Project, In_Tree,
-                        "cannot remove a source from another project",
-                        Excluded.Location);
-                  end if;
-
-                  --  We used to exit here, but in fact when a source is
-                  --  overridden in an extended project we have only marked the
-                  --  original source file if we stop here, not the one from
-                  --  the extended project.
-                  --  ??? We could exit (and thus be faster) if the loop could
-                  --  be done only on the current project, but this isn't
-                  --  compatible with the way gprbuild works with excluded
-                  --  sources apparently
-
-                  --  exit;
+                  Excluded_Sources_Htable.Remove
+                    (Excluded_Sources, Source.File);
                end if;
 
                Next (Iter);
             end loop;
 
-            OK := OK or Excluded.Found;
+            Proj := Proj.Extends;
+         end loop;
+
+         --  If we have any excluded element left, that means we did not find
+         --  the source file
+
+         Excluded := Excluded_Sources_Htable.Get_First (Excluded_Sources);
+         while Excluded /= No_File_Found loop
+
+            --  Check if the file belongs to another imported project to
+            --  provide a better error message.
+
+            Src := Find_Source
+              (In_Tree          => In_Tree,
+               Project          => Project,
+               In_Imported_Only => True,
+               Base_Name        => Excluded.File);
 
-            if not OK then
             Err_Vars.Error_Msg_File_1 := Excluded.File;
+
+            if Src = No_Source then
                Error_Msg
                  (Project, In_Tree, "unknown file {", Excluded.Location);
+            else
+               Error_Msg
+                 (Project, In_Tree,
+                  "cannot remove a source from an imported project: {",
+                  Excluded.Location);
             end if;
 
-            Excluded := Excluded_Sources_Htable.Get_Next;
+            Excluded := Excluded_Sources_Htable.Get_Next (Excluded_Sources);
          end loop;
       end Mark_Excluded_Sources;
 
@@ -7949,17 +7961,19 @@ package body Prj.Nmsc is
 
    begin
       Source_Names.Reset;
-      Find_Excluded_Sources (Project, In_Tree);
+      Find_Excluded_Sources (Project, In_Tree, Excluded_Sources);
 
       if (Get_Mode = Ada_Only and then Is_A_Language (Project, Name_Ada))
         or else (Get_Mode = Multi_Language
                   and then Project.Languages /= No_Language_Index)
       then
          if Get_Mode = Multi_Language then
-            Load_Naming_Exceptions (Project, In_Tree);
+            Load_Naming_Exceptions (Project, In_Tree, Excluded_Sources);
          end if;
 
-         Find_Sources (Project, In_Tree, Proc_Data, Allow_Duplicate_Basenames);
+         Find_Sources
+           (Project, In_Tree, Proc_Data, Allow_Duplicate_Basenames,
+            Excluded => Excluded_Sources);
          Mark_Excluded_Sources;
 
          if Get_Mode = Multi_Language then

gcc/ada/prj.adb

@@ -469,6 +469,52 @@ package body Prj is
       Reset (Seen);
    end For_Every_Project_Imported;
 
+   -----------------
+   -- Find_Source --
+   -----------------
+
+   function Find_Source
+     (In_Tree          : Project_Tree_Ref;
+      Project          : Project_Id;
+      In_Imported_Only : Boolean;
+      Base_Name        : File_Name_Type) return Source_Id
+   is
+      Result   : Source_Id  := No_Source;
+
+      procedure Look_For_Sources (Proj : Project_Id; Src : in out Source_Id);
+      --  Look for Base_Name in the sources of Proj
+
+      procedure Look_For_Sources (Proj : Project_Id; Src : in out Source_Id) is
+         Iterator : Source_Iterator;
+      begin
+         Iterator := For_Each_Source (In_Tree => In_Tree, Project => Proj);
+         while Element (Iterator) /= No_Source loop
+            if Element (Iterator).File = Base_Name then
+               Src := Element (Iterator);
+               return;
+            end if;
+            Next (Iterator);
+         end loop;
+      end Look_For_Sources;
+
+      procedure For_Imported_Projects is new For_Every_Project_Imported
+        (State => Source_Id, Action => Look_For_Sources);
+
+   begin
+      if In_Imported_Only then
+         Look_For_Sources (Project, Result);
+         if Result = No_Source then
+            For_Imported_Projects
+              (By         => Project,
+               With_State => Result);
+         end if;
+      else
+         Look_For_Sources (No_Project, Result);
+      end if;
+
+      return Result;
+   end Find_Source;
+
    --------------
    -- Get_Mode --
    --------------

gcc/ada/prj.ads

@@ -1295,6 +1295,15 @@ package Prj is
    procedure Next (Iter : in out Source_Iterator);
    --  Move on to the next source
 
+   function Find_Source
+     (In_Tree          : Project_Tree_Ref;
+      Project          : Project_Id;
+      In_Imported_Only : Boolean;
+      Base_Name        : File_Name_Type) return Source_Id;
+   --  Find the first source file with the given name either in the whole tree
+   --  (if In_Imported_Only is False) or in the projects imported or extended
+   --  by Project otherwise.
+
    -----------------------
    -- Project_Tree_Data --
    -----------------------

gcc/ada/sem_res.adb

@@ -7600,7 +7600,7 @@ package body Sem_Res is
 
       --  Generate cross-reference. We needed to wait until full overloading
       --  resolution was complete to do this, since otherwise we can't tell if
-      --  we are an Lvalue of not.
+      --  we are an lvalue of not.
 
       if May_Be_Lvalue (N) then
          Generate_Reference (Entity (S), S, 'm');

gcc/ada/sem_util.adb

@@ -7155,7 +7155,7 @@ package body Sem_Util is
          when N_Assignment_Statement =>
             return N = Name (P);
 
-            --  Function call arguments are never Lvalues
+            --  Function call arguments are never lvalues
 
          when N_Function_Call =>
             return False;
@@ -7241,7 +7241,7 @@ package body Sem_Util is
             end;
 
          --  Test for appearing in a conversion that itself appears
-         --  in an Lvalue context, since this should be an Lvalue.
+         --  in an lvalue context, since this should be an lvalue.
 
          when N_Type_Conversion =>
             return Known_To_Be_Assigned (P);
@@ -7276,8 +7276,8 @@ package body Sem_Util is
             return N = Prefix (P)
               and then Name_Implies_Lvalue_Prefix (Attribute_Name (P));
 
-         --  For an expanded name, the name is an Lvalue if the expanded name
-         --  is an Lvalue, but the prefix is never an Lvalue, since it is just
+         --  For an expanded name, the name is an lvalue if the expanded name
+         --  is an lvalue, but the prefix is never an lvalue, since it is just
          --  the scope where the name is found.
 
          when N_Expanded_Name        =>
@@ -7287,11 +7287,11 @@ package body Sem_Util is
                return False;
             end if;
 
-         --  For a selected component A.B, A is certainly an Lvalue if A.B is
-         --  an Lvalue. B is a little interesting, if we have A.B:=3, there is
-         --  some discussion as to whether B is an Lvalue or not, we choose to
-         --  say it is. Note however that A is not an Lvalue if it is of an
-         --  access type since this is an implicit dereference.
+         --  For a selected component A.B, A is certainly an lvalue if A.B is.
+         --  B is a little interesting, if we have A.B := 3, there is some
+         --  discussion as to whether B is an lvalue or not, we choose to say
+         --  it is. Note however that A is not an lvalue if it is of an access
+         --  type since this is an implicit dereference.
 
          when N_Selected_Component   =>
             if N = Prefix (P)
@@ -7304,8 +7304,8 @@ package body Sem_Util is
             end if;
 
          --  For an indexed component or slice, the index or slice bounds is
-         --  never an Lvalue. The prefix is an Lvalue if the indexed component
-         --  or slice is an Lvalue, except if it is an access type, where we
+         --  never an lvalue. The prefix is an lvalue if the indexed component
+         --  or slice is an lvalue, except if it is an access type, where we
          --  have an implicit dereference.
 
          when N_Indexed_Component    =>
@@ -7317,17 +7317,17 @@ package body Sem_Util is
                return May_Be_Lvalue (P);
             end if;
 
-         --  Prefix of a reference is an Lvalue if the reference is an Lvalue
+         --  Prefix of a reference is an lvalue if the reference is an lvalue
 
          when N_Reference            =>
             return May_Be_Lvalue (P);
 
-         --  Prefix of explicit dereference is never an Lvalue
+         --  Prefix of explicit dereference is never an lvalue
 
          when N_Explicit_Dereference =>
             return False;
 
-         --  Function call arguments are never Lvalues
+         --  Function call arguments are never lvalues
 
          when N_Function_Call =>
             return False;
@@ -7414,7 +7414,7 @@ package body Sem_Util is
             end;
 
          --  Test for appearing in a conversion that itself appears in an
-         --  Lvalue context, since this should be an Lvalue.
+         --  lvalue context, since this should be an lvalue.
 
          when N_Type_Conversion =>
             return May_Be_Lvalue (P);
@@ -7424,7 +7424,7 @@ package body Sem_Util is
          when N_Object_Renaming_Declaration =>
             return True;
 
-         --  All other references are definitely not Lvalues
+         --  All other references are definitely not lvalues
 
          when others =>
             return False;

gcc/ada/sem_warn.adb

@@ -475,7 +475,7 @@ package body Sem_Warn is
            and then Present (Entity (N))
            and then Entity (N) = Var
          then
-            --  If this is an Lvalue, then definitely abandon, since
+            --  If this is an lvalue, then definitely abandon, since
             --  this could be a direct modification of the variable.
 
             if May_Be_Lvalue (N) then