+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.
-- --
-- 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- --
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");
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));
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
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;
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.
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);
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);
-----------
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;
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);
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;
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;
-- 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
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;
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);
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;
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)
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;
OSDN Git Service
