mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-19 03:40:26 +08:00
[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
This commit is contained in:
Arnaud Charlet
parent
4bffd4e061
commit
f7ca1d041c
@ -1,3 +1,34 @@
|
||||
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.
|
||||
|
||||
@ -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:
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -6209,151 +6209,11 @@ package body Prj.Nmsc is
|
||||
Write_Line ("Starting to look for directories");
|
||||
end if;
|
||||
|
||||
-- Check the object directory
|
||||
|
||||
pragma Assert (Object_Dir.Kind = Single,
|
||||
"Object_Dir is not a single string");
|
||||
|
||||
-- We set the object directory to its default
|
||||
-- We set the object directory to its default. It may be set to nil, if
|
||||
-- there is no sources in the project.
|
||||
|
||||
Data.Object_Directory := Data.Directory;
|
||||
|
||||
if Object_Dir.Value /= Empty_String then
|
||||
Get_Name_String (Object_Dir.Value);
|
||||
|
||||
if Name_Len = 0 then
|
||||
Error_Msg
|
||||
(Project, In_Tree,
|
||||
"Object_Dir cannot be empty",
|
||||
Object_Dir.Location);
|
||||
|
||||
else
|
||||
-- We check that the specified object directory does exist
|
||||
|
||||
Locate_Directory
|
||||
(Project,
|
||||
In_Tree,
|
||||
File_Name_Type (Object_Dir.Value),
|
||||
Data.Directory.Display_Name,
|
||||
Data.Object_Directory.Name,
|
||||
Data.Object_Directory.Display_Name,
|
||||
Create => "object",
|
||||
Location => Object_Dir.Location,
|
||||
Current_Dir => Current_Dir,
|
||||
Externally_Built => Data.Externally_Built);
|
||||
|
||||
if Data.Object_Directory = No_Path_Information then
|
||||
|
||||
-- The object directory does not exist, report an error if the
|
||||
-- project is not externally built.
|
||||
|
||||
if not Data.Externally_Built then
|
||||
Err_Vars.Error_Msg_File_1 :=
|
||||
File_Name_Type (Object_Dir.Value);
|
||||
Error_Msg
|
||||
(Project, In_Tree,
|
||||
"the object directory { cannot be found",
|
||||
Data.Location);
|
||||
end if;
|
||||
|
||||
-- Do not keep a nil Object_Directory. Set it to the specified
|
||||
-- (relative or absolute) path. This is for the benefit of
|
||||
-- tools that recover from errors; for example, these tools
|
||||
-- could create the non existent directory.
|
||||
|
||||
Data.Object_Directory.Display_Name :=
|
||||
Path_Name_Type (Object_Dir.Value);
|
||||
|
||||
if Osint.File_Names_Case_Sensitive then
|
||||
Data.Object_Directory.Name :=
|
||||
Path_Name_Type (Object_Dir.Value);
|
||||
else
|
||||
Get_Name_String (Object_Dir.Value);
|
||||
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
|
||||
Data.Object_Directory.Name := Name_Find;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
elsif Subdirs /= null then
|
||||
Name_Len := 1;
|
||||
Name_Buffer (1) := '.';
|
||||
Locate_Directory
|
||||
(Project,
|
||||
In_Tree,
|
||||
Name_Find,
|
||||
Data.Directory.Display_Name,
|
||||
Data.Object_Directory.Name,
|
||||
Data.Object_Directory.Display_Name,
|
||||
Create => "object",
|
||||
Location => Object_Dir.Location,
|
||||
Current_Dir => Current_Dir,
|
||||
Externally_Built => Data.Externally_Built);
|
||||
end if;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
if Data.Object_Directory = No_Path_Information then
|
||||
Write_Line ("No object directory");
|
||||
else
|
||||
Write_Str ("Object directory: """);
|
||||
Write_Str (Get_Name_String (Data.Object_Directory.Display_Name));
|
||||
Write_Line ("""");
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Check the exec directory
|
||||
|
||||
pragma Assert (Exec_Dir.Kind = Single,
|
||||
"Exec_Dir is not a single string");
|
||||
|
||||
-- We set the object directory to its default
|
||||
|
||||
Data.Exec_Directory := Data.Object_Directory;
|
||||
|
||||
if Exec_Dir.Value /= Empty_String then
|
||||
Get_Name_String (Exec_Dir.Value);
|
||||
|
||||
if Name_Len = 0 then
|
||||
Error_Msg
|
||||
(Project, In_Tree,
|
||||
"Exec_Dir cannot be empty",
|
||||
Exec_Dir.Location);
|
||||
|
||||
else
|
||||
-- We check that the specified exec directory does exist
|
||||
|
||||
Locate_Directory
|
||||
(Project,
|
||||
In_Tree,
|
||||
File_Name_Type (Exec_Dir.Value),
|
||||
Data.Directory.Display_Name,
|
||||
Data.Exec_Directory.Name,
|
||||
Data.Exec_Directory.Display_Name,
|
||||
Create => "exec",
|
||||
Location => Exec_Dir.Location,
|
||||
Current_Dir => Current_Dir,
|
||||
Externally_Built => Data.Externally_Built);
|
||||
|
||||
if Data.Exec_Directory = No_Path_Information then
|
||||
Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
|
||||
Error_Msg
|
||||
(Project, In_Tree,
|
||||
"the exec directory { cannot be found",
|
||||
Data.Location);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
if Data.Exec_Directory = No_Path_Information then
|
||||
Write_Line ("No exec directory");
|
||||
else
|
||||
Write_Str ("Exec directory: """);
|
||||
Write_Str (Get_Name_String (Data.Exec_Directory.Display_Name));
|
||||
Write_Line ("""");
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Look for the source directories
|
||||
|
||||
if Current_Verbosity = High then
|
||||
@ -6492,6 +6352,148 @@ package body Prj.Nmsc is
|
||||
end loop;
|
||||
end;
|
||||
|
||||
-- Check the object directory
|
||||
|
||||
pragma Assert (Object_Dir.Kind = Single,
|
||||
"Object_Dir is not a single string");
|
||||
|
||||
if Object_Dir.Value /= Empty_String then
|
||||
Get_Name_String (Object_Dir.Value);
|
||||
|
||||
if Name_Len = 0 then
|
||||
Error_Msg
|
||||
(Project, In_Tree,
|
||||
"Object_Dir cannot be empty",
|
||||
Object_Dir.Location);
|
||||
|
||||
else
|
||||
-- We check that the specified object directory does exist
|
||||
|
||||
Locate_Directory
|
||||
(Project,
|
||||
In_Tree,
|
||||
File_Name_Type (Object_Dir.Value),
|
||||
Data.Directory.Display_Name,
|
||||
Data.Object_Directory.Name,
|
||||
Data.Object_Directory.Display_Name,
|
||||
Create => "object",
|
||||
Location => Object_Dir.Location,
|
||||
Current_Dir => Current_Dir,
|
||||
Externally_Built => Data.Externally_Built);
|
||||
|
||||
if Data.Object_Directory = No_Path_Information then
|
||||
|
||||
-- The object directory does not exist, report an error if the
|
||||
-- project is not externally built.
|
||||
|
||||
if not Data.Externally_Built then
|
||||
Err_Vars.Error_Msg_File_1 :=
|
||||
File_Name_Type (Object_Dir.Value);
|
||||
Error_Msg
|
||||
(Project, In_Tree,
|
||||
"the object directory { cannot be found",
|
||||
Data.Location);
|
||||
end if;
|
||||
|
||||
-- Do not keep a nil Object_Directory. Set it to the specified
|
||||
-- (relative or absolute) path. This is for the benefit of
|
||||
-- tools that recover from errors; for example, these tools
|
||||
-- could create the non existent directory.
|
||||
|
||||
Data.Object_Directory.Display_Name :=
|
||||
Path_Name_Type (Object_Dir.Value);
|
||||
|
||||
if Osint.File_Names_Case_Sensitive then
|
||||
Data.Object_Directory.Name :=
|
||||
Path_Name_Type (Object_Dir.Value);
|
||||
else
|
||||
Get_Name_String (Object_Dir.Value);
|
||||
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
|
||||
Data.Object_Directory.Name := Name_Find;
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
elsif Data.Object_Directory /= No_Path_Information and then
|
||||
Subdirs /= null
|
||||
then
|
||||
Name_Len := 1;
|
||||
Name_Buffer (1) := '.';
|
||||
Locate_Directory
|
||||
(Project,
|
||||
In_Tree,
|
||||
Name_Find,
|
||||
Data.Directory.Display_Name,
|
||||
Data.Object_Directory.Name,
|
||||
Data.Object_Directory.Display_Name,
|
||||
Create => "object",
|
||||
Location => Object_Dir.Location,
|
||||
Current_Dir => Current_Dir,
|
||||
Externally_Built => Data.Externally_Built);
|
||||
end if;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
if Data.Object_Directory = No_Path_Information then
|
||||
Write_Line ("No object directory");
|
||||
else
|
||||
Write_Str ("Object directory: """);
|
||||
Write_Str (Get_Name_String (Data.Object_Directory.Display_Name));
|
||||
Write_Line ("""");
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Check the exec directory
|
||||
|
||||
pragma Assert (Exec_Dir.Kind = Single,
|
||||
"Exec_Dir is not a single string");
|
||||
|
||||
-- We set the object directory to its default
|
||||
|
||||
Data.Exec_Directory := Data.Object_Directory;
|
||||
|
||||
if Exec_Dir.Value /= Empty_String then
|
||||
Get_Name_String (Exec_Dir.Value);
|
||||
|
||||
if Name_Len = 0 then
|
||||
Error_Msg
|
||||
(Project, In_Tree,
|
||||
"Exec_Dir cannot be empty",
|
||||
Exec_Dir.Location);
|
||||
|
||||
else
|
||||
-- We check that the specified exec directory does exist
|
||||
|
||||
Locate_Directory
|
||||
(Project,
|
||||
In_Tree,
|
||||
File_Name_Type (Exec_Dir.Value),
|
||||
Data.Directory.Display_Name,
|
||||
Data.Exec_Directory.Name,
|
||||
Data.Exec_Directory.Display_Name,
|
||||
Create => "exec",
|
||||
Location => Exec_Dir.Location,
|
||||
Current_Dir => Current_Dir,
|
||||
Externally_Built => Data.Externally_Built);
|
||||
|
||||
if Data.Exec_Directory = No_Path_Information then
|
||||
Err_Vars.Error_Msg_File_1 := File_Name_Type (Exec_Dir.Value);
|
||||
Error_Msg
|
||||
(Project, In_Tree,
|
||||
"the exec directory { cannot be found",
|
||||
Data.Location);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if Current_Verbosity = High then
|
||||
if Data.Exec_Directory = No_Path_Information then
|
||||
Write_Line ("No exec directory");
|
||||
else
|
||||
Write_Str ("Exec directory: """);
|
||||
Write_Str (Get_Name_String (Data.Exec_Directory.Display_Name));
|
||||
Write_Line ("""");
|
||||
end if;
|
||||
end if;
|
||||
end Get_Directories;
|
||||
|
||||
---------------
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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, "
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user