Skip to content

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

[multiple changes] 

2010-06-18  Pascal Obry  <obry@adacore.com>

	* make.adb, prj-nmsc.adb: Fix source filenames casing in debug output.

2010-06-18  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb: For gnatcheck, add -gnatec= switch for a global
	configuration pragmas file and, if -U is not used, for a local one.

2010-06-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_elim.adb (Check_Eliminated): Use full information on entity name
	when it is given in the pragma by a selected component.
	(Check_For_Eliminated_Subprogram): Do no emit error if within a
	instance body that is itself within a generic unit.
	* sem_ch12.adb (Analyze_Subprogram_Instance): If the subprogram is
	eliminated, mark as well the anonymous subprogram that is its alias
	and appears within the wrapper package.

From-SVN: r160986
parent 175d6559
Showing with 184 additions and 18 deletions
gcc/ada/ChangeLog
2010-06-18 Pascal Obry <obry@adacore.com>
* make.adb, prj-nmsc.adb: Fix source filenames casing in debug output.
2010-06-18 Vincent Celier <celier@adacore.com>
* gnatcmd.adb: For gnatcheck, add -gnatec= switch for a global
configuration pragmas file and, if -U is not used, for a local one.
2010-06-18 Ed Schonberg <schonberg@adacore.com>
* sem_elim.adb (Check_Eliminated): Use full information on entity name
when it is given in the pragma by a selected component.
(Check_For_Eliminated_Subprogram): Do no emit error if within a
instance body that is itself within a generic unit.
* sem_ch12.adb (Analyze_Subprogram_Instance): If the subprogram is
eliminated, mark as well the anonymous subprogram that is its alias
and appears within the wrapper package.
2010-06-18 Bob Duff <duff@adacore.com>
* g-pehage.ads, g-pehage.adb (Produce): Clean up some of the code.
......
gcc/ada/gnatcmd.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -122,6 +122,7 @@ procedure GNATCmd is
Naming_String : constant SA := new String'("naming");
Binder_String : constant SA := new String'("binder");
Builder_String : constant SA := new String'("builder");
Compiler_String : constant SA := new String'("compiler");
Check_String : constant SA := new String'("check");
Synchronize_String : constant SA := new String'("synchronize");
......@@ -139,7 +140,8 @@ procedure GNATCmd is
new String_List'((Naming_String, Binder_String));
Packages_To_Check_By_Check : constant String_List_Access :=
new String_List'((Naming_String, Check_String, Compiler_String));
new String_List'
((Naming_String, Builder_String, Check_String, Compiler_String));
Packages_To_Check_By_Sync : constant String_List_Access :=
new String_List'((Naming_String, Synchronize_String, Compiler_String));
......@@ -363,7 +365,7 @@ procedure GNATCmd is
if Add_Sources then
-- For gnatcheck, gnatpp and gnatmetric , create a temporary file
-- For gnatcheck, gnatpp and gnatmetric, create a temporary file
-- and put the list of sources in it.
if The_Command = Check or else
......@@ -2198,6 +2200,87 @@ begin
Add_To_Carg_Switches
(new String'("-gnatem=" & Get_Name_String (M_File)));
end if;
-- For gnatcheck, also indicate a global configuration pragmas
-- file and, if -U is not used, a local one.
if The_Command = Check then
declare
Pkg : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Builder,
In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree);
Variable : Variable_Value :=
Prj.Util.Value_Of
(Name => No_Name,
Attribute_Or_Array_Name =>
Name_Global_Configuration_Pragmas,
In_Package => Pkg,
In_Tree => Project_Tree);
begin
if (Variable = Nil_Variable_Value or else
Length_Of_Name (Variable.Value) = 0)
and then Pkg /= No_Package
then
Variable :=
Prj.Util.Value_Of
(Name => Name_Ada,
Attribute_Or_Array_Name => Name_Global_Config_File,
In_Package => Pkg,
In_Tree => Project_Tree);
end if;
if Variable /= Nil_Variable_Value and then
Length_Of_Name (Variable.Value) /= 0
then
Add_To_Carg_Switches
(new String'
("-gnatec=" & Get_Name_String (Variable.Value)));
end if;
end;
if not All_Projects then
declare
Pkg : constant Prj.Package_Id :=
Prj.Util.Value_Of
(Name => Name_Compiler,
In_Packages => Project.Decl.Packages,
In_Tree => Project_Tree);
Variable : Variable_Value :=
Prj.Util.Value_Of
(Name => No_Name,
Attribute_Or_Array_Name =>
Name_Local_Configuration_Pragmas,
In_Package => Pkg,
In_Tree => Project_Tree);
begin
if (Variable = Nil_Variable_Value or else
Length_Of_Name (Variable.Value) = 0)
and then Pkg /= No_Package
then
Variable :=
Prj.Util.Value_Of
(Name => Name_Ada,
Attribute_Or_Array_Name =>
Name_Local_Config_File,
In_Package => Pkg,
In_Tree => Project_Tree);
end if;
if Variable /= Nil_Variable_Value and then
Length_Of_Name (Variable.Value) /= 0
then
Add_To_Carg_Switches
(new String'
("-gnatec=" &
Get_Name_String (Variable.Value)));
end if;
end;
end if;
end if;
end;
end if;
......
gcc/ada/make.adb
......@@ -1395,7 +1395,7 @@ package body Make is
if Project_Of_Current_Object_Directory /= Project then
Project_Of_Current_Object_Directory := Project;
Object_Directory := Project.Object_Directory.Name;
Object_Directory := Project.Object_Directory.Display_Name;
-- Set the working directory to the object directory of the actual
-- project.
......@@ -6078,7 +6078,7 @@ package body Make is
exception
when others =>
-- Delete the temporary mapping file, if one was created.
-- Delete the temporary mapping file, if one was created
if Mapping_Path /= No_Path then
Delete_Temporary_File (Project_Tree, Mapping_Path);
......
gcc/ada/prj-nmsc.adb
......@@ -703,7 +703,7 @@ package body Prj.Nmsc is
if Current_Verbosity = High then
Write_Str ("Adding source File: ");
Write_Str (Get_Name_String (File_Name));
Write_Str (Get_Name_String (Display_File));
if Index /= 0 then
Write_Str (" at" & Index'Img);
......@@ -813,8 +813,8 @@ package body Prj.Nmsc is
-----------
procedure Check
(Project : Project_Id;
Data : in out Tree_Processing_Data)
(Project : Project_Id;
Data : in out Tree_Processing_Data)
is
Specs : Array_Element_Id;
Bodies : Array_Element_Id;
......@@ -4883,7 +4883,7 @@ package body Prj.Nmsc is
if not Removed and then List = Nil_String then
if Current_Verbosity = High then
Write_Str (" Adding Source Dir=");
Write_Line (Get_Name_String (Path_Id));
Write_Line (Get_Name_String (Display_Path_Id));
end if;
String_Element_Table.Increment_Last (Data.Tree.String_Elements);
......@@ -6845,7 +6845,9 @@ package body Prj.Nmsc is
begin
if Current_Verbosity = High then
Write_Attr ("Source_Dir", Source_Directory);
Write_Attr
("Source_Dir",
Source_Directory (Source_Directory'First .. Dir_Last));
Write_Line (Num_Nod.Number'Img);
end if;
......@@ -7382,7 +7384,7 @@ package body Prj.Nmsc is
while Current /= Nil_String loop
Element := In_Tree.String_Elements.Table (Current);
Write_Str (" ");
Write_Line (Get_Name_String (Element.Value));
Write_Line (Get_Name_String (Element.Display_Value));
Current := Element.Next;
end loop;
......
gcc/ada/sem_ch12.adb
......@@ -4005,11 +4005,14 @@ package body Sem_Ch12 is
-- If the instance is a child unit, mark the Id accordingly. Mark
-- the anonymous entity as well, which is the real subprogram and
-- which is used when the instance appears in a context clause.
-- Similarly, propagate the Is_Eliminated flag to handle properly
-- nested eliminated subprograms.
Set_Is_Child_Unit (Act_Decl_Id, Is_Child_Unit (Defining_Entity (N)));
Set_Is_Child_Unit (Anon_Id, Is_Child_Unit (Defining_Entity (N)));
New_Overloaded_Entity (Act_Decl_Id);
Check_Eliminated (Act_Decl_Id);
Set_Is_Eliminated (Anon_Id, Is_Eliminated (Act_Decl_Id));
-- In compilation unit case, kill elaboration checks on the
-- instantiation, since they are never needed -- the body is
......
gcc/ada/sem_elim.adb
......@@ -29,6 +29,7 @@ with Errout; use Errout;
with Lib; use Lib;
with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
with Sem; use Sem;
with Sem_Prag; use Sem_Prag;
with Sem_Util; use Sem_Util;
......@@ -287,7 +288,8 @@ package body Sem_Elim is
goto Continue;
end if;
-- Find enclosing unit
-- Find enclosing unit, and verify that its name and those of its
-- parents match.
Scop := Cunit_Entity (Current_Sem_Unit);
......@@ -329,9 +331,6 @@ package body Sem_Elim is
end if;
Scop := Scope (Scop);
while Ekind (Scop) = E_Block loop
Scop := Scope (Scop);
end loop;
if Scop /= Standard_Standard and then J = 1 then
goto Continue;
......@@ -342,8 +341,60 @@ package body Sem_Elim is
goto Continue;
end if;
-- Check for case of given entity is a library level subprogram
-- and we have the single parameter Eliminate case, a match!
if Present (Elmt.Entity_Node)
and then Elmt.Entity_Scope /= null
then
-- Check that names of enclosing scopes match.
-- Skip blocks and wrapper package of subprogram instances,
-- which do not appear in the pragma.
Scop := Scope (E);
for J in reverse Elmt.Entity_Scope'Range loop
while Ekind (Scop) = E_Block
or else
(Ekind (Scop) = E_Package
and then Is_Wrapper_Package (Scop))
loop
Scop := Scope (Scop);
end loop;
if Elmt.Entity_Scope (J) /= Chars (Scop) then
if Ekind (Scop) /= E_Protected_Type
or else Comes_From_Source (Scop)
then
goto Continue;
-- For simple protected declarations, retrieve the source
-- name of the object, which appeared in the Eliminate
-- pragma.
else
declare
Decl : constant Node_Id :=
Original_Node (Parent (Scop));
begin
if Elmt.Entity_Scope (J) /=
Chars (Defining_Identifier (Decl))
then
if J > 0 then
null;
end if;
goto Continue;
end if;
end;
end if;
end if;
Scop := Scope (Scop);
end loop;
end if;
-- If given entity is a library level subprogram and pragma had a
-- single parameter, a match!
if Is_Compilation_Unit (E)
and then Is_Subprogram (E)
......@@ -672,7 +723,15 @@ package body Sem_Elim is
Enclosing_Subp := Enclosing_Subprogram (Enclosing_Subp);
end loop;
Eliminate_Error_Msg (N, Ultimate_Subp);
-- Emit error, unless we are within an instance body and
-- the expander is disabled, which indicates an instance
-- within an enclosing generic.
if In_Instance_Body and then not Expander_Active then
null;
else
Eliminate_Error_Msg (N, Ultimate_Subp);
end if;
end if;
end Check_For_Eliminated_Subprogram;
......
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