[multiple changes]

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

	* prj.adb, prj.ads, prj-env.adb, prj-conf.adb, prj-tree.adb,
	mlib-prj.adb (Private_Part.Ada_Prj_Objects_File_Set,
	Ada_Prj_Include_File_Set): Removed, since not needed
	Code clean up.

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

	* sem_ch4.adb (Analyze_Set_Membership): New procedure, subsidiary of
	Analyze_Membership_Op.

	* sem_res.adb (Resolve_Set_Membership): New procedure, subsidiary of
	Resolve_Membership_Op.

	* exp_ch4.adb (Expand_Set_Membership): New procedure, subsidiary of
	Expand_N_In.

2009-07-13  Robert Dewar  <dewar@adacore.com>

	* clean.adb: Minor reformattting

From-SVN: r149569

12 files changed, 261 insertions, 41 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2e12962..1475a55 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,27 @@
 2009-07-13  Emmanuel Briot  <briot@adacore.com>
 
+	* prj.adb, prj.ads, prj-env.adb, prj-conf.adb, prj-tree.adb,
+	mlib-prj.adb (Private_Part.Ada_Prj_Objects_File_Set,
+	Ada_Prj_Include_File_Set): Removed, since not needed
+	Code clean up.
+
+2009-07-13  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch4.adb (Analyze_Set_Membership): New procedure, subsidiary of
+	Analyze_Membership_Op.
+
+	* sem_res.adb (Resolve_Set_Membership): New procedure, subsidiary of
+	Resolve_Membership_Op.
+
+	* exp_ch4.adb (Expand_Set_Membership): New procedure, subsidiary of
+	Expand_N_In.
+
+2009-07-13  Robert Dewar  <dewar@adacore.com>
+
+	* clean.adb: Minor reformattting
+
+2009-07-13  Emmanuel Briot  <briot@adacore.com>
+
 	* gnatcmd.adb, prj-proc.adb, make.adb, mlib-prj.adb, prj-ext.adb,
 	gnat_ugn.texi, prj.adb, prj.ads, clean.adb, prj-nmsc.adb, prj-util.adb,
 	prj-conf.adb, gnatname.adb, prj-env.adb, prj-env.ads, prj-tree.adb,
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb
index e4d4387..790b842 100644
--- a/gcc/ada/clean.adb
+++ b/gcc/ada/clean.adb
@@ -1045,13 +1045,14 @@ package body Clean is
                      Proj := Project_Tree.Projects;
                      while Proj /= null loop
 
-                        --  for gnatmake, when the project specifies more than
-                        --  Ada as a language (even if course we could not find
-                        --  any source file for the other languages), we will
-                        --  take all object files found in the object
+                        --  For gnatmake, when the project specifies more than
+                        --  just Ada as a language (even if course we could not
+                        --  find any source file for the other languages), we
+                        --  will take all the object files found in the object
                         --  directories. Since we know the project supports at
                         --  least Ada, we just have to test whether it has at
-                        --  least two languages, and not care about the sources
+                        --  least two languages, and we do not care about the
+                        --  sources.
 
                         if Proj.Project.Languages /= null
                           and then Proj.Project.Languages.Next /= null
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 87ba037..e6e539e 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4121,6 +4121,67 @@ package body Exp_Ch4 is
       Rop    : constant Node_Id    := Right_Opnd (N);
       Static : constant Boolean    := Is_OK_Static_Expression (N);
 
+      procedure Expand_Set_Membership;
+      --  For each disjunct we create a simple equality or membership test.
+      --  The whole membership is rewritten as a short-circuit disjunction.
+
+      ---------------------------
+      -- Expand_Set_Membership --
+      ---------------------------
+
+      procedure Expand_Set_Membership is
+         Alt  : Node_Id;
+         Res  : Node_Id;
+
+         function Make_Cond (Alt : Node_Id) return Node_Id;
+         --  If the alternative is a subtype mark, create a simple membership
+         --  test. Otherwise create an equality test for it.
+
+         ---------------
+         -- Make_Cond --
+         ---------------
+
+         function Make_Cond (Alt : Node_Id) return Node_Id is
+            Cond : Node_Id;
+            L    : constant Node_Id := New_Copy (Lop);
+            R    : constant Node_Id := Relocate_Node (Alt);
+
+         begin
+            if Is_Entity_Name (Alt)
+              and then Is_Type (Entity (Alt))
+            then
+               Cond :=
+                 Make_In (Sloc (Alt),
+                   Left_Opnd  => L,
+                   Right_Opnd => R);
+            else
+               Cond := Make_Op_Eq (Sloc (Alt),
+                 Left_Opnd  => L,
+                 Right_Opnd => R);
+            end if;
+
+            return Cond;
+         end Make_Cond;
+
+      --  Start of proessing for Expand_N_In
+
+      begin
+         Alt := Last (Alternatives (N));
+         Res := Make_Cond (Alt);
+
+         Prev (Alt);
+         while Present (Alt) loop
+            Res :=
+              Make_Or_Else (Sloc (Alt),
+                Left_Opnd  => Make_Cond (Alt),
+                Right_Opnd => Res);
+            Prev (Alt);
+         end loop;
+
+         Rewrite (N, Res);
+         Analyze_And_Resolve (N, Standard_Boolean);
+      end Expand_Set_Membership;
+
       procedure Substitute_Valid_Check;
       --  Replaces node N by Lop'Valid. This is done when we have an explicit
       --  test for the left operand being in range of its subtype.
@@ -4146,6 +4207,13 @@ package body Exp_Ch4 is
    --  Start of processing for Expand_N_In
 
    begin
+
+      if Present (Alternatives (N)) then
+         Remove_Side_Effects (Lop);
+         Expand_Set_Membership;
+         return;
+      end if;
+
       --  Check case of explicit test for an expression in range of its
       --  subtype. This is suspicious usage and we replace it with a 'Valid
       --  test and give a warning.
@@ -4733,6 +4801,10 @@ package body Exp_Ch4 is
               Left_Opnd  => Left_Opnd (N),
               Right_Opnd => Right_Opnd (N))));
 
+      --  If this is a set membership, preserve list of alternatives
+
+      Set_Alternatives (Right_Opnd (N), Alternatives (Original_Node (N)));
+
       --  We want this to appear as coming from source if original does (see
       --  transformations in Expand_N_In).
 
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index f737e96..7c39819 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -752,7 +752,7 @@ begin
       --  a VM, since representations are largely symbolic there.
 
       if Back_End_Mode = Declarations_Only
-        and then (not (Back_Annotate_Rep_Info or else Inspector_Mode)
+        and then (not (Back_Annotate_Rep_Info or Inspector_Mode)
                    or else Main_Kind = N_Subunit
                    or else Targparm.Frontend_Layout_On_Target
                    or else Targparm.VM_Target /= No_VM)
diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb
index 51de49b..d01a329 100644
--- a/gcc/ada/mlib-prj.adb
+++ b/gcc/ada/mlib-prj.adb
@@ -1328,12 +1328,12 @@ package body MLib.Prj is
 
          In_Main_Object_Directory := True;
 
-         --  for gnatmake, when the project specifies more than Ada as a
+         --  For gnatmake, when the project specifies more than just Ada as a
          --  language (even if course we could not find any source file for
          --  the other languages), we will take all object files found in the
          --  object directories. Since we know the project supports at least
          --  Ada, we just have to test whether it has at least two languages,
-         --  and not care about the sources
+         --  and not care about the sources.
 
          Foreign_Sources := For_Project.Languages.Next /= null;
          Current_Proj := For_Project;
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index 59b6c14..10fbdd7 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -1185,10 +1185,14 @@ package body Prj.Conf is
          Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
          Name := Name_Find;
 
+         --  An invalid project name to avoid conflicts with user-created ones
+         Name_Len := 5;
+         Name_Buffer (1 .. Name_Len) := "_auto";
+
          Config_File :=
            Create_Project
              (In_Tree        => Project_Tree,
-              Name           => Name_Default,
+              Name           => Name_Find,
               Full_Path      => Path_Name_Type (Name),
               Is_Config_File => True);
 
diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb
index 7541e52..db688ce 100644
--- a/gcc/ada/prj-env.adb
+++ b/gcc/ada/prj-env.adb
@@ -1641,7 +1641,6 @@ package body Prj.Env is
          Set_Path_File_Var
            (Project_Include_Path_File,
             Get_Name_String (In_Tree.Private_Part.Current_Source_Path_File));
-         In_Tree.Private_Part.Ada_Prj_Include_File_Set := True;
       end if;
 
       if Including_Libraries then
@@ -1654,7 +1653,6 @@ package body Prj.Env is
               (Project_Objects_Path_File,
                Get_Name_String
                  (In_Tree.Private_Part.Current_Object_Path_File));
-            In_Tree.Private_Part.Ada_Prj_Objects_File_Set := True;
          end if;
 
       else
@@ -1667,7 +1665,6 @@ package body Prj.Env is
               (Project_Objects_Path_File,
                Get_Name_String
                  (In_Tree.Private_Part.Current_Object_Path_File));
-            In_Tree.Private_Part.Ada_Prj_Objects_File_Set := True;
          end if;
       end if;
    end Set_Ada_Paths;
diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb
index 42b281f..f054976 100644
--- a/gcc/ada/prj-tree.adb
+++ b/gcc/ada/prj-tree.adb
@@ -2848,15 +2848,17 @@ package body Prj.Tree is
          Qualifier := Configuration;
       end if;
 
-      Prj.Tree.Tree_Private_Part.Projects_Htable.Set
-        (In_Tree.Projects_HT,
-         Name,
-         Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
-         (Name           => Name,
-          Canonical_Path => No_Path,
-          Node           => Project,
-          Extended       => False,
-          Proj_Qualifier => Qualifier));
+      if not Is_Config_File then
+         Prj.Tree.Tree_Private_Part.Projects_Htable.Set
+           (In_Tree.Projects_HT,
+            Name,
+            Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
+              (Name           => Name,
+               Canonical_Path => No_Path,
+               Node           => Project,
+               Extended       => False,
+               Proj_Qualifier => Qualifier));
+      end if;
 
       return Project;
    end Create_Project;
@@ -3044,7 +3046,9 @@ package body Prj.Tree is
 
       --  Find out the case sensitivity of the attribute
 
-      if Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration then
+      if Prj_Or_Pkg /= Empty_Node
+        and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
+      then
          Pkg      := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
          Start_At := First_Attribute_Of (Pkg);
       else
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index c8f30ec..f9726be 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -223,14 +223,12 @@ package body Prj is
       --  the empty string. On VMS, this has the effect of deassigning
       --  the logical names.
 
-      if Tree.Private_Part.Ada_Prj_Include_File_Set then
+      if Tree.Private_Part.Current_Source_Path_File /= No_Path then
          Setenv (Project_Include_Path_File, "");
-         Tree.Private_Part.Ada_Prj_Include_File_Set := False;
       end if;
 
-      if Tree.Private_Part.Ada_Prj_Objects_File_Set then
+      if Tree.Private_Part.Current_Object_Path_File /= No_Path then
          Setenv (Project_Objects_Path_File, "");
-         Tree.Private_Part.Ada_Prj_Objects_File_Set := False;
       end if;
    end Delete_All_Temp_Files;
 
@@ -879,8 +877,6 @@ package body Prj is
 
       Tree.Private_Part.Current_Source_Path_File := No_Path;
       Tree.Private_Part.Current_Object_Path_File := No_Path;
-      Tree.Private_Part.Ada_Prj_Include_File_Set := False;
-      Tree.Private_Part.Ada_Prj_Objects_File_Set := False;
    end Reset;
 
    -------------------
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index b359515..4154e9b 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -1477,7 +1477,10 @@ private
 
       Current_Source_Path_File : Path_Name_Type := No_Path;
       --  Current value of project source path file env var. Used to avoid
-      --  setting the env var to the same value.
+      --  setting the env var to the same value. When different from No_Path,
+      --  this indicates that logical names (VMS) or environment variables were
+      --  created and should be deassigned to avoid polluting the environment
+      --  on VMS.
       --  gnatmake only
 
       Current_Object_Path_File : Path_Name_Type := No_Path;
@@ -1485,16 +1488,6 @@ private
       --  setting the env var to the same value.
       --  gnatmake only
 
-      Ada_Prj_Include_File_Set : Boolean := False;
-      Ada_Prj_Objects_File_Set : Boolean := False;
-      --  These flags are set to True when the corresponding environment
-      --  variables are set and are used to give these environment variables an
-      --  empty string value at the end of the program. This has no practical
-      --  effect on most platforms, except on VMS where the logical names are
-      --  deassigned, thus avoiding the pollution of the environment of the
-      --  caller.
-      --  gnatmake only
-
    end record;
    --  Type to represent the part of a project tree which is private to the
    --  Project Manager.
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 98cbde3..ccfcf1f 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -2050,11 +2050,105 @@ package body Sem_Ch4 is
 
       end Try_One_Interp;
 
+      procedure Analyze_Set_Membership;
+      --  If a set of alternatives is present, analyze each and find the
+      --  common type to which they must all resolve.
+
+      ----------------------------
+      -- Analyze_Set_Membership --
+      ----------------------------
+
+      procedure Analyze_Set_Membership is
+         Alt               : Node_Id;
+         Index             : Interp_Index;
+         It                : Interp;
+
+         Candidate_Interps : Node_Id;
+         Common_Type       : Entity_Id := Empty;
+
+      begin
+         Analyze (L);
+         Candidate_Interps := L;
+
+         if not Is_Overloaded (L) then
+            Common_Type := Etype (L);
+
+            Alt := First (Alternatives (N));
+            while Present (Alt) loop
+               Analyze (Alt);
+
+               if not Has_Compatible_Type (Alt, Common_Type) then
+                  Wrong_Type (Alt, Common_Type);
+               end if;
+
+               Next (Alt);
+            end loop;
+
+         else
+            Alt := First (Alternatives (N));
+            while Present (Alt) loop
+               Analyze (Alt);
+               if not Is_Overloaded (Alt) then
+                  Common_Type := Etype (Alt);
+
+               else
+                  Get_First_Interp (Alt, Index, It);
+                  while Present (It.Typ) loop
+                     if
+                       not Has_Compatible_Type (Candidate_Interps, It.Typ)
+                     then
+                        Remove_Interp (Index);
+                     end if;
+                     Get_Next_Interp (Index, It);
+                  end loop;
+
+                  Get_First_Interp (Alt, Index, It);
+                  if No (It.Typ) then
+                     Error_Msg_N ("alternative has no legal type", Alt);
+                     return;
+                  end if;
+
+                  --  If alternative is not overloaded, we have a
+                  --  unique type for all of them.
+
+                  Set_Etype (Alt, It.Typ);
+                  Get_Next_Interp (Index, It);
+
+                  if No (It.Typ) then
+                     Set_Is_Overloaded (Alt, False);
+                     Common_Type := Etype (Alt);
+                  end if;
+
+                  Candidate_Interps := Alt;
+               end if;
+
+               Next (Alt);
+            end loop;
+         end if;
+
+         Set_Etype (N, Standard_Boolean);
+
+         if Present (Common_Type) then
+            Set_Etype (L, Common_Type);
+            Set_Is_Overloaded (L, False);
+
+         else
+            Error_Msg_N ("cannot resolve membership operation", N);
+         end if;
+      end Analyze_Set_Membership;
+
    --  Start of processing for Analyze_Membership_Op
 
    begin
       Analyze_Expression (L);
 
+      if No (R)
+        and then Extensions_Allowed
+      then
+         Analyze_Set_Membership;
+         return;
+      end if;
+
       if Nkind (R) = N_Range
         or else (Nkind (R) = N_Attribute_Reference
                   and then Attribute_Name (R) = Name_Range)
@@ -2090,6 +2184,7 @@ package body Sem_Ch4 is
       Set_Etype (N, Standard_Boolean);
 
       if Comes_From_Source (N)
+        and then Present (Right_Opnd (N))
         and then Is_CPP_Class (Etype (Etype (Right_Opnd (N))))
       then
          Error_Msg_N ("membership test not applicable to cpp-class types", N);
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index f691847..42a7e12 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -6734,16 +6734,52 @@ package body Sem_Res is
    procedure Resolve_Membership_Op (N : Node_Id; Typ : Entity_Id) is
       pragma Warnings (Off, Typ);
 
-      L : constant Node_Id := Left_Opnd (N);
+      L : constant Node_Id := Left_Opnd  (N);
       R : constant Node_Id := Right_Opnd (N);
       T : Entity_Id;
 
+      procedure Resolve_Set_Membership;
+      --  Analysis has determined a unique type for the left operand.
+      --  Use it to resolve the disjuncts.
+
+      ----------------------------
+      -- Resolve_Set_Membership --
+      ----------------------------
+
+      procedure Resolve_Set_Membership is
+         Alt : Node_Id;
+
+      begin
+         Resolve (L, Etype (L));
+
+         Alt := First (Alternatives (N));
+         while Present (Alt) loop
+
+            --  Alternative is an expression, a range
+            --  or a subtype mark.
+
+            if not Is_Entity_Name (Alt)
+              or else not Is_Type (Entity (Alt))
+            then
+               Resolve (Alt, Etype (L));
+            end if;
+
+            Next (Alt);
+         end loop;
+      end Resolve_Set_Membership;
+
+   --  start of processing for Resolve_Membership_Op
+
    begin
       if L = Error or else R = Error then
          return;
       end if;
 
-      if not Is_Overloaded (R)
+      if Present (Alternatives (N)) then
+         Resolve_Set_Membership;
+         return;
+
+      elsif not Is_Overloaded (R)
         and then
           (Etype (R) = Universal_Integer or else
            Etype (R) = Universal_Real)