Skip to content

R
riscv-gcc-1
Commit f7ca1d04 by Arnaud Charlet
Options

[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
parent 4bffd4e0
Showing with 116 additions and 47 deletions
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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment