[multiple changes]

2009-04-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Use_One_Type): If both clauses appear on the same unit,
	the second is redundant, regardless of scopes.

2009-04-15  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (Get_Directories): Check for sources before checking
	the object directory as when there are no sources, they may not be any
	object directory.

	* make.adb (Gnatmake): Do not attempt to get the path name of the exec
	directory, when there are no exec directory.

2009-04-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_type.adb (Remove_Conversions): In order to resolve spurious
	ambiguities, refine removal of universal interpretations from complex
	expressions with literal arguments, when some numeric operators have
	been declared abstract.

2009-04-15  Ed Falis  <falis@adacore.com>

	* init.c: Map SIGSEGV to Storage_Error for all targets for uniformity
	and backward compatibility for targets using probing for stack overflow

2009-04-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pragma, case 'Obsolescent): Pragma is legal
	after any declaration, including renaming declarations.

From-SVN: r146091

gcc/ada/ChangeLog

+2009-04-15  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Use_One_Type): If both clauses appear on the same unit,
+	the second is redundant, regardless of scopes.
+
+2009-04-15  Vincent Celier  <celier@adacore.com>
+
+	* prj-nmsc.adb (Get_Directories): Check for sources before checking
+	the object directory as when there are no sources, they may not be any
+	object directory.
+
+	* make.adb (Gnatmake): Do not attempt to get the path name of the exec
+	directory, when there are no exec directory.
+
+2009-04-15  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_type.adb (Remove_Conversions): In order to resolve spurious
+	ambiguities, refine removal of universal interpretations from complex
+	expressions with literal arguments, when some numeric operators have
+	been declared abstract.
+
+2009-04-15  Ed Falis  <falis@adacore.com>
+
+	* init.c: Map SIGSEGV to Storage_Error for all targets for uniformity
+	and backward compatibility for targets using probing for stack overflow
+
+2009-04-15  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma, case 'Obsolescent): Pragma is legal
+	after any declaration, including renaming declarations.
+
 2009-04-15  Arnaud Charlet  <charlet@adacore.com>
 
 	* gcc-interface/Make-lang.in: Update dependencies.

gcc/ada/init.c

@@ -1816,7 +1816,7 @@ __gnat_map_signal (int sig)
       break;
     case SIGSEGV:
       exception = &storage_error;
-      msg = "SIGSEGV: possible stack overflow";
+      msg = "SIGSEGV";
       break;
     case SIGBUS:
       exception = &storage_error;
@@ -1841,7 +1841,7 @@ __gnat_map_signal (int sig)
 #else
       /* VxWorks 6 kernel mode with probing. SIGBUS for guard page hit */
     case SIGSEGV:
-      exception = &program_error;
+      exception = &storage_error;
       msg = "SIGSEGV";
       break;
     case SIGBUS:
@@ -1857,7 +1857,7 @@ __gnat_map_signal (int sig)
       msg = "SIGILL: possible stack overflow";
       break;
     case SIGSEGV:
-      exception = &program_error;
+      exception = &storage_error;
       msg = "SIGSEGV";
       break;
     case SIGBUS:

gcc/ada/make.adb

@@ -5718,7 +5718,11 @@ package body Make is
             end if;
          end if;
 
-         if Main_Project /= No_Project then
+         if Main_Project /= No_Project
+           and then
+             Project_Tree.Projects.Table
+               (Main_Project).Exec_Directory /= No_Path_Information
+         then
             declare
                Exec_File_Name : constant String :=
                                   Get_Name_String (Executable);

gcc/ada/sem_ch8.adb

@@ -6130,12 +6130,12 @@ package body Sem_Ch8 is
 
       Prev_Use   : Node_Id := Empty;
       Redundant  : Node_Id := Empty;
-      --  The Use_Clause which is actually redundant. In the simplest case
-      --  it is Pack itself, but when we compile a body we install its
-      --  context before that of its spec, in which case it is the use_clause
-      --  in the spec that will appear to be redundant, and we want the
-      --  warning to be placed on the body. Similar complications appear when
-      --  the redundancy is between a child unit and one of its ancestors.
+      --  The Use_Clause which is actually redundant. In the simplest case it
+      --  is Pack itself, but when we compile a body we install its context
+      --  before that of its spec, in which case it is the use_clause in the
+      --  spec that will appear to be redundant, and we want the warning to be
+      --  placed on the body. Similar complications appear when the redundancy
+      --  is between a child unit and one of its ancestors.
 
    begin
       Set_Redundant_Use (Clause, True);
@@ -6149,12 +6149,12 @@ package body Sem_Ch8 is
 
       if not Is_Compilation_Unit (Current_Scope) then
 
-         --  If the use_clause is in an inner scope, it is made redundant
-         --  by some clause in the current context, with one exception:
-         --  If we're compiling a nested package body, and the use_clause
-         --  comes from the corresponding spec, the clause is not necessarily
-         --  fully redundant, so we should not warn.  If a warning was
-         --  warranted, it would have been given when the spec was processed.
+         --  If the use_clause is in an inner scope, it is made redundant by
+         --  some clause in the current context, with one exception: If we're
+         --  compiling a nested package body, and the use_clause comes from the
+         --  corresponding spec, the clause is not necessarily fully redundant,
+         --  so we should not warn. If a warning was warranted, it would have
+         --  been given when the spec was processed.
 
          if Nkind (Parent (Decl)) = N_Package_Specification then
             declare
@@ -6249,12 +6249,12 @@ package body Sem_Ch8 is
       elsif Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Declaration
         and then Present (Parent_Spec (Unit (Cunit (Current_Sem_Unit))))
       then
-         --  Use_clause is in child unit of current unit, and the child
-         --  unit appears in the context of the body of the parent, so it
-         --  has been installed first, even though it is the redundant one.
-         --  Depending on their placement in the context, the visible or the
-         --  private parts of the two units, either might appear as redundant,
-         --  but the message has to be on the current unit.
+         --  Use_clause is in child unit of current unit, and the child unit
+         --  appears in the context of the body of the parent, so it has been
+         --  installed first, even though it is the redundant one. Depending on
+         --  their placement in the context, the visible or the private parts
+         --  of the two units, either might appear as redundant, but the
+         --  message has to be on the current unit.
 
          if Get_Source_Unit (Cur_Use) = Current_Sem_Unit then
             Redundant := Cur_Use;
@@ -6367,9 +6367,9 @@ package body Sem_Ch8 is
       if Ekind (S) = E_Void then
          null;
 
-      --  Set scope depth if not a non-concurrent type, and we have not
-      --  yet set the scope depth. This means that we have the first
-      --  occurrence of the scope, and this is where the depth is set.
+      --  Set scope depth if not a non-concurrent type, and we have not yet set
+      --  the scope depth. This means that we have the first occurrence of the
+      --  scope, and this is where the depth is set.
 
       elsif (not Is_Type (S) or else Is_Concurrent_Type (S))
         and then not Scope_Depth_Set (S)
@@ -6427,9 +6427,9 @@ package body Sem_Ch8 is
          Write_Eol;
       end if;
 
-      --  Deal with copying flags from the previous scope to this one. This
-      --  is not necessary if either scope is standard, or if the new scope
-      --  is a child unit.
+      --  Deal with copying flags from the previous scope to this one. This is
+      --  not necessary if either scope is standard, or if the new scope is a
+      --  child unit.
 
       if S /= Standard_Standard
         and then Scope (S) /= Standard_Standard
@@ -6711,6 +6711,7 @@ package body Sem_Ch8 is
                   if not From_With_Type (E) then
                      Set_Is_Immediately_Visible (E,
                        Is_Visible_Child_Unit (E) or else In_Open_Scopes (E));
+
                   else
                      pragma Assert
                        (Nkind (Parent (E)) = N_Defining_Program_Unit_Name
@@ -7124,10 +7125,10 @@ package body Sem_Ch8 is
       elsif In_Open_Scopes (Scope (T)) then
          null;
 
-      --  A limited view cannot appear in a use_type clause. However, an
-      --  access type whose designated type is limited has the flag but
-      --  is not itself a limited view unless we only have a limited view
-      --  of its enclosing package.
+      --  A limited view cannot appear in a use_type clause. However, an access
+      --  type whose designated type is limited has the flag but is not itself
+      --  a limited view unless we only have a limited view of its enclosing
+      --  package.
 
       elsif From_With_Type (T)
         and then From_With_Type (Scope (T))
@@ -7172,8 +7173,8 @@ package body Sem_Ch8 is
          --  as use visible. The analysis then reinstalls the spec along with
          --  its context. The use clause P.T is now recognized as redundant,
          --  but in the wrong context. Do not emit a warning in such cases.
-         --  Do not emit a warning either if we are in an instance, there
-         --  is no redundancy between an outer use_clause and one that appears
+         --  Do not emit a warning either if we are in an instance, there is
+         --  no redundancy between an outer use_clause and one that appears
          --  within the generic.
 
         and then not Spec_Reloaded_For_Body
@@ -7219,10 +7220,10 @@ package body Sem_Ch8 is
                --  Start of processing for Use_Clause_Known
 
                begin
-                  --  If both current use type clause and the use type
-                  --  clause for the type are at the compilation unit level,
-                  --  one of the units must be an ancestor of the other, and
-                  --  the warning belongs on the descendant.
+                  --  If both current use type clause and the use type clause
+                  --  for the type are at the compilation unit level, one of
+                  --  the units must be an ancestor of the other, and the
+                  --  warning belongs on the descendant.
 
                   if Nkind (Parent (Clause1)) = N_Compilation_Unit
                        and then
@@ -7240,6 +7241,16 @@ package body Sem_Ch8 is
                      Unit1 := Unit (Parent (Clause1));
                      Unit2 := Unit (Parent (Clause2));
 
+                     --  If both clauses are on same unit, report redundancy
+
+                     if Unit1 = Unit2 then
+                        Error_Msg_Sloc := Sloc (Current_Use_Clause (T));
+                        Error_Msg_NE
+                          ("& is already use-visible through previous "
+                           & "use_type_clause #?", Clause1, T);
+                        return;
+                     end if;
+
                      --  There is a redundant use type clause in a child unit.
                      --  Determine which of the units is more deeply nested.
                      --  If a unit is a package instance, retrieve the entity

gcc/ada/sem_prag.adb

@@ -9229,6 +9229,7 @@ package body Sem_Prag is
                if Nkind (Decl) not in N_Declaration
                  and then Nkind (Decl) not in N_Later_Decl_Item
                  and then Nkind (Decl) not in N_Generic_Declaration
+                 and then Nkind (Decl) not in N_Renaming_Declaration
                then
                   Error_Pragma
                     ("pragma% misplaced, "

gcc/ada/sem_type.adb

@@ -885,7 +885,7 @@ package body Sem_Type is
       then
          return True;
 
-      --  An aggregate is compatible with an array or record type
+      --  An aggregate is compatible with an array or record type.
 
       elsif T2 = Any_Composite
         and then Ekind (T1) in E_Array_Type .. E_Record_Subtype
@@ -1423,15 +1423,37 @@ package body Sem_Type is
                   end if;
 
                elsif Is_Numeric_Type (Etype (F1))
-                 and then
-                   (Has_Abstract_Interpretation (Act1)
-                     or else Has_Abstract_Interpretation (Act2))
+                 and then Has_Abstract_Interpretation (Act1)
                then
-                  if It = Disambiguate.It1 then
-                     return Disambiguate.It2;
-                  elsif It = Disambiguate.It2 then
-                     return Disambiguate.It1;
-                  end if;
+
+                  --  Current interpretation is not the right one because
+                  --  it expects a numeric operand. Examine all the other
+                  --  ones.
+
+                  declare
+                     I : Interp_Index;
+                     It : Interp;
+
+                  begin
+                     Get_First_Interp (N, I, It);
+
+                     while Present (It.Typ) loop
+                        if
+                          not Is_Numeric_Type (Etype (First_Formal (It.Nam)))
+                        then
+                           if No (Act2)
+                             or else not Has_Abstract_Interpretation (Act2)
+                             or else not Is_Numeric_Type
+                               (Etype (Next_Formal (First_Formal (It.Nam))))
+                           then
+                              return It;
+                           end if;
+                        end if;
+                        Get_Next_Interp (I, It);
+                     end loop;
+
+                     return No_Interp;
+                  end;
                end if;
             end if;