[multiple changes]
2011-08-04 Emmanuel Briot <briot@adacore.com> * makeutl.adb (Complete_Mains): when a multi-unit source file is specified on the gprbuild command line, we need to compile all units within that file, not just the first one we find Fix error message for mains that are not found. 2011-08-04 Thomas Quinot <quinot@adacore.com> * sem_ch6.adb: Update comment. * sem_ch12.adb: Minor reformatting. 2011-08-04 Bob Duff <duff@adacore.com> * s-tasren.adb (Task_Do_Or_Queue): Previous code was reading Acceptor.Terminate_Alternative without locking Acceptor, which causes a race condition whose symptom is to fail to lock Parent. That, in turn, causes Parent.Awake_Count to be accessed without locking Parent, which causes another race condition whose symptom is that Parent.Awake_Count can be off by 1 (either too high or too low). The solution is to lock Parent unconditionally, and then lock Acceptor, before reading Acceptor.Terminate_Alternative. From-SVN: r177352
This commit is contained in:
Arnaud Charlet
parent
4fdebd93e0
commit
756ef2a03d
|
|
@ -1,3 +1,26 @@
|
|||
2011-08-04 Emmanuel Briot <briot@adacore.com>
|
||||
|
||||
* makeutl.adb (Complete_Mains): when a multi-unit source file is
|
||||
specified on the gprbuild command line, we need to compile all units
|
||||
within that file, not just the first one we find
|
||||
Fix error message for mains that are not found.
|
||||
|
||||
2011-08-04 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* sem_ch6.adb: Update comment.
|
||||
* sem_ch12.adb: Minor reformatting.
|
||||
|
||||
2011-08-04 Bob Duff <duff@adacore.com>
|
||||
|
||||
* s-tasren.adb (Task_Do_Or_Queue): Previous code was reading
|
||||
Acceptor.Terminate_Alternative without locking Acceptor, which causes a
|
||||
race condition whose symptom is to fail to lock Parent. That, in turn,
|
||||
causes Parent.Awake_Count to be accessed without locking Parent, which
|
||||
causes another race condition whose symptom is that Parent.Awake_Count
|
||||
can be off by 1 (either too high or too low). The solution is to lock
|
||||
Parent unconditionally, and then lock Acceptor, before reading
|
||||
Acceptor.Terminate_Alternative.
|
||||
|
||||
2011-08-04 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* debug.adb: Update comment.
|
||||
|
|
|
|||
|
|
@ -1280,13 +1280,71 @@ package body Makeutl is
|
|||
procedure Complete_All is new For_Project_And_Aggregated
|
||||
(Do_Complete);
|
||||
|
||||
procedure Add_Multi_Unit_Sources
|
||||
(Tree : Project_Tree_Ref;
|
||||
Source : Prj.Source_Id);
|
||||
-- Add all units from the same file as the multi-unit Source.
|
||||
|
||||
----------------------------
|
||||
-- Add_Multi_Unit_Sources --
|
||||
----------------------------
|
||||
|
||||
procedure Add_Multi_Unit_Sources
|
||||
(Tree : Project_Tree_Ref;
|
||||
Source : Prj.Source_Id)
|
||||
is
|
||||
Iter : Source_Iterator;
|
||||
Src : Prj.Source_Id;
|
||||
begin
|
||||
Debug_Output
|
||||
("Found multi-unit source file in project", Source.Project.Name);
|
||||
|
||||
Iter := For_Each_Source
|
||||
(In_Tree => Tree, Project => Source.Project);
|
||||
|
||||
while Element (Iter) /= No_Source loop
|
||||
Src := Element (Iter);
|
||||
|
||||
if Src.File = Source.File
|
||||
and then Src.Index /= Source.Index
|
||||
then
|
||||
if Src.File = Source.File then
|
||||
Debug_Output
|
||||
("Add main in project, index=" & Src.Index'Img);
|
||||
end if;
|
||||
|
||||
Names.Increment_Last;
|
||||
Names.Table (Names.Last) :=
|
||||
(File => Src.File,
|
||||
Index => Src.Index,
|
||||
Location => No_Location,
|
||||
Source => Src,
|
||||
Project => Src.Project,
|
||||
Tree => Tree);
|
||||
|
||||
Builder_Data (Tree).Number_Of_Mains :=
|
||||
Builder_Data (Tree).Number_Of_Mains + 1;
|
||||
end if;
|
||||
|
||||
Next (Iter);
|
||||
end loop;
|
||||
end Add_Multi_Unit_Sources;
|
||||
|
||||
-----------------
|
||||
-- Do_Complete --
|
||||
-----------------
|
||||
|
||||
procedure Do_Complete
|
||||
(Project : Project_Id; Tree : Project_Tree_Ref) is
|
||||
begin
|
||||
if Mains.Number_Of_Mains (Tree) > 0
|
||||
or else Mains.Count_Of_Mains_With_No_Tree > 0
|
||||
then
|
||||
for J in Names.First .. Names.Last loop
|
||||
-- Traverse in reverse order, since in the case of multi-unit
|
||||
-- files we will be adding extra files at the end, and there's
|
||||
-- no need to process them in tun.
|
||||
|
||||
for J in reverse Names.First .. Names.Last loop
|
||||
declare
|
||||
File : Main_Info := Names.Table (J);
|
||||
Main_Id : File_Name_Type := File.File;
|
||||
|
|
@ -1327,7 +1385,7 @@ package body Makeutl is
|
|||
if Current_Verbosity = High then
|
||||
Debug_Output
|
||||
("Search for main """ & Main
|
||||
& """ in "
|
||||
& '"' & File.Index'Img & " in "
|
||||
& Get_Name_String (Debug_Name (File.Tree))
|
||||
& ", project", Project.Name);
|
||||
end if;
|
||||
|
|
@ -1402,6 +1460,19 @@ package body Makeutl is
|
|||
end if;
|
||||
|
||||
if Source /= No_Source then
|
||||
-- If we have found a multi-unit source file but
|
||||
-- did not specify an index initially, we'll need
|
||||
-- to compile all the units from the same source
|
||||
-- file
|
||||
|
||||
if Source.Index /= 0
|
||||
and then File.Index = 0
|
||||
then
|
||||
Add_Multi_Unit_Sources (File.Tree, Source);
|
||||
end if;
|
||||
|
||||
-- Now update the original Main, otherwise it will
|
||||
-- be reported as not found.
|
||||
|
||||
Debug_Output ("Found main in project",
|
||||
Source.Project.Name);
|
||||
|
|
@ -1412,7 +1483,8 @@ package body Makeutl is
|
|||
Names.Table (J).Tree := File.Tree;
|
||||
|
||||
Builder_Data (File.Tree).Number_Of_Mains :=
|
||||
Builder_Data (File.Tree).Number_Of_Mains + 1;
|
||||
Builder_Data (File.Tree).Number_Of_Mains
|
||||
+ 1;
|
||||
Mains.Count_Of_Mains_With_No_Tree :=
|
||||
Mains.Count_Of_Mains_With_No_Tree - 1;
|
||||
end if;
|
||||
|
|
@ -1451,9 +1523,11 @@ package body Makeutl is
|
|||
|
||||
if Mains.Count_Of_Mains_With_No_Tree > 0 then
|
||||
for J in Names.First .. Names.Last loop
|
||||
Fail_Program
|
||||
(Project_Tree, '"' & Get_Name_String (Names.Table (J).File)
|
||||
& """ is not a source of any project");
|
||||
if Names.Table (J).Source = No_Source then
|
||||
Fail_Program
|
||||
(Project_Tree, '"' & Get_Name_String (Names.Table (J).File)
|
||||
& """ is not a source of any project");
|
||||
end if;
|
||||
end loop;
|
||||
end if;
|
||||
end Complete_Mains;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL 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- --
|
||||
|
|
@ -1077,7 +1077,6 @@ package body System.Tasking.Rendezvous is
|
|||
Old_State : constant Entry_Call_State := Entry_Call.State;
|
||||
Acceptor : constant Task_Id := Entry_Call.Called_Task;
|
||||
Parent : constant Task_Id := Acceptor.Common.Parent;
|
||||
Parent_Locked : Boolean := False;
|
||||
Null_Body : Boolean;
|
||||
|
||||
begin
|
||||
|
|
@ -1105,24 +1104,23 @@ package body System.Tasking.Rendezvous is
|
|||
-- record for another call.
|
||||
-- We rely on the Caller's lock for call State mod's.
|
||||
|
||||
-- We can't lock Acceptor.Parent while holding Acceptor,
|
||||
-- so lock it in advance if we expect to need to lock it.
|
||||
|
||||
if Acceptor.Terminate_Alternative then
|
||||
STPO.Write_Lock (Parent);
|
||||
Parent_Locked := True;
|
||||
end if;
|
||||
-- If Acceptor.Terminate_Alternative is True, we need to lock Parent and
|
||||
-- Acceptor, in that order; otherwise, we only need a lock on
|
||||
-- Acceptor. However, we can't check Acceptor.Terminate_Alternative
|
||||
-- until Acceptor is locked. Therefore, we need to lock both. Attempts
|
||||
-- to avoid locking Parent tend to result in race conditions. It would
|
||||
-- work to unlock Parent immediately upon finding
|
||||
-- Acceptor.Terminate_Alternative to be False, but that violates the
|
||||
-- rule of properly nested locking (see System.Tasking).
|
||||
|
||||
STPO.Write_Lock (Parent);
|
||||
STPO.Write_Lock (Acceptor);
|
||||
|
||||
-- If the acceptor is not callable, abort the call and return False
|
||||
|
||||
if not Acceptor.Callable then
|
||||
STPO.Unlock (Acceptor);
|
||||
|
||||
if Parent_Locked then
|
||||
STPO.Unlock (Parent);
|
||||
end if;
|
||||
STPO.Unlock (Parent);
|
||||
|
||||
pragma Assert (Entry_Call.State < Done);
|
||||
|
||||
|
|
@ -1186,10 +1184,7 @@ package body System.Tasking.Rendezvous is
|
|||
|
||||
STPO.Wakeup (Acceptor, Acceptor_Sleep);
|
||||
STPO.Unlock (Acceptor);
|
||||
|
||||
if Parent_Locked then
|
||||
STPO.Unlock (Parent);
|
||||
end if;
|
||||
STPO.Unlock (Parent);
|
||||
|
||||
STPO.Write_Lock (Entry_Call.Self);
|
||||
Initialization.Wakeup_Entry_Caller
|
||||
|
|
@ -1207,10 +1202,7 @@ package body System.Tasking.Rendezvous is
|
|||
end if;
|
||||
|
||||
STPO.Unlock (Acceptor);
|
||||
|
||||
if Parent_Locked then
|
||||
STPO.Unlock (Parent);
|
||||
end if;
|
||||
STPO.Unlock (Parent);
|
||||
end if;
|
||||
|
||||
return True;
|
||||
|
|
@ -1236,10 +1228,7 @@ package body System.Tasking.Rendezvous is
|
|||
and then Entry_Call.Cancellation_Attempted)
|
||||
then
|
||||
STPO.Unlock (Acceptor);
|
||||
|
||||
if Parent_Locked then
|
||||
STPO.Unlock (Parent);
|
||||
end if;
|
||||
STPO.Unlock (Parent);
|
||||
|
||||
STPO.Write_Lock (Entry_Call.Self);
|
||||
|
||||
|
|
@ -1261,10 +1250,7 @@ package body System.Tasking.Rendezvous is
|
|||
New_State (Entry_Call.With_Abort, Entry_Call.State);
|
||||
|
||||
STPO.Unlock (Acceptor);
|
||||
|
||||
if Parent_Locked then
|
||||
STPO.Unlock (Parent);
|
||||
end if;
|
||||
STPO.Unlock (Parent);
|
||||
|
||||
if Old_State /= Entry_Call.State
|
||||
and then Entry_Call.State = Now_Abortable
|
||||
|
|
|
|||
|
|
@ -3380,9 +3380,11 @@ package body Sem_Ch12 is
|
|||
end;
|
||||
|
||||
-- If we are generating calling stubs, we never need a body for an
|
||||
-- instantiation from source. However normal processing occurs for
|
||||
-- any generic instantiation appearing in generated code, since we
|
||||
-- do not generate stubs in that case.
|
||||
-- instantiation from source in the visible part, because in that
|
||||
-- case we'll be generating stubs for any subprogram in the instance.
|
||||
-- However normal processing occurs for instantiations in generated
|
||||
-- code or in the private part, since in those cases we do not
|
||||
-- generate stubs.
|
||||
|
||||
if Distribution_Stub_Mode = Generate_Caller_Stub_Body
|
||||
and then Comes_From_Source (N)
|
||||
|
|
@ -6295,8 +6297,8 @@ package body Sem_Ch12 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- Do not copy the associated node, which points to
|
||||
-- the generic copy of the aggregate.
|
||||
-- Do not copy the associated node, which points to the generic copy
|
||||
-- of the aggregate.
|
||||
|
||||
declare
|
||||
use Atree.Unchecked_Access;
|
||||
|
|
@ -6310,9 +6312,9 @@ package body Sem_Ch12 is
|
|||
Set_Field5 (New_N, Copy_Generic_Descendant (Field5 (N)));
|
||||
end;
|
||||
|
||||
-- Allocators do not have an identifier denoting the access type,
|
||||
-- so we must locate it through the expression to check whether
|
||||
-- the views are consistent.
|
||||
-- Allocators do not have an identifier denoting the access type, so we
|
||||
-- must locate it through the expression to check whether the views are
|
||||
-- consistent.
|
||||
|
||||
elsif Nkind (N) = N_Allocator
|
||||
and then Nkind (Expression (N)) = N_Qualified_Expression
|
||||
|
|
@ -6373,16 +6375,13 @@ package body Sem_Ch12 is
|
|||
-- Don't copy Ident or Comment pragmas, since the comment belongs to the
|
||||
-- generic unit, not to the instantiating unit.
|
||||
|
||||
elsif Nkind (N) = N_Pragma
|
||||
and then Instantiating
|
||||
then
|
||||
elsif Nkind (N) = N_Pragma and then Instantiating then
|
||||
declare
|
||||
Prag_Id : constant Pragma_Id := Get_Pragma_Id (N);
|
||||
begin
|
||||
if Prag_Id = Pragma_Ident
|
||||
or else Prag_Id = Pragma_Comment
|
||||
then
|
||||
if Prag_Id = Pragma_Ident or else Prag_Id = Pragma_Comment then
|
||||
New_N := Make_Null_Statement (Sloc (N));
|
||||
|
||||
else
|
||||
Copy_Descendants;
|
||||
end if;
|
||||
|
|
@ -6411,10 +6410,10 @@ package body Sem_Ch12 is
|
|||
else
|
||||
Copy_Descendants;
|
||||
|
||||
if Instantiating
|
||||
and then Nkind (N) = N_Subprogram_Body
|
||||
then
|
||||
if Instantiating and then Nkind (N) = N_Subprogram_Body then
|
||||
Set_Generic_Parent (Specification (New_N), N);
|
||||
|
||||
-- Should preserve Corresponding_Spec??? (12.3(14))
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
|
@ -6455,9 +6454,7 @@ package body Sem_Ch12 is
|
|||
if Renamed_Object (E1) = Pack then
|
||||
return True;
|
||||
|
||||
elsif E1 = P
|
||||
or else Renamed_Object (E1) = P
|
||||
then
|
||||
elsif E1 = P or else Renamed_Object (E1) = P then
|
||||
return False;
|
||||
|
||||
elsif Is_Actual_Of_Previous_Formal (E1) then
|
||||
|
|
@ -6479,7 +6476,7 @@ package body Sem_Ch12 is
|
|||
Instance_Envs.Table
|
||||
(Instance_Envs.Last).Instantiated_Parent.Act_Id;
|
||||
else
|
||||
Par := Current_Instantiated_Parent.Act_Id;
|
||||
Par := Current_Instantiated_Parent.Act_Id;
|
||||
end if;
|
||||
|
||||
if Ekind (Scop) = E_Generic_Package
|
||||
|
|
@ -6675,12 +6672,12 @@ package body Sem_Ch12 is
|
|||
end loop;
|
||||
|
||||
-- At this point P1 and P2 are at the same distance from the root.
|
||||
-- We examine their parents until we find a common declarative
|
||||
-- list, at which point we can establish their relative placement
|
||||
-- by comparing their ultimate slocs. If we reach the root,
|
||||
-- N1 and N2 do not descend from the same declarative list (e.g.
|
||||
-- one is nested in the declarative part and the other is in a block
|
||||
-- in the statement part) and the earlier one is already frozen.
|
||||
-- We examine their parents until we find a common declarative list,
|
||||
-- at which point we can establish their relative placement by
|
||||
-- comparing their ultimate slocs. If we reach the root, N1 and N2
|
||||
-- do not descend from the same declarative list (e.g. one is nested
|
||||
-- in the declarative part and the other is in a block in the
|
||||
-- statement part) and the earlier one is already frozen.
|
||||
|
||||
while not Is_List_Member (P1)
|
||||
or else not Is_List_Member (P2)
|
||||
|
|
@ -6814,9 +6811,9 @@ package body Sem_Ch12 is
|
|||
In_Same_Declarative_Part (Freeze_Node (Par), Parent (Enc_I)))
|
||||
then
|
||||
-- The enclosing package may contain several instances. Rather
|
||||
-- than computing the earliest point at which to insert its
|
||||
-- freeze node, we place it at the end of the declarative part
|
||||
-- of the parent of the generic.
|
||||
-- than computing the earliest point at which to insert its freeze
|
||||
-- node, we place it at the end of the declarative part of the
|
||||
-- parent of the generic.
|
||||
|
||||
Insert_After_Last_Decl
|
||||
(Freeze_Node (Par), Package_Freeze_Node (Enc_I));
|
||||
|
|
@ -6838,12 +6835,12 @@ package body Sem_Ch12 is
|
|||
|
||||
-- Freeze package that encloses instance, and place node after
|
||||
-- package that encloses generic. If enclosing package is already
|
||||
-- frozen we have to assume it is at the proper place. This may be
|
||||
-- a potential ABE that requires dynamic checking. Do not add a
|
||||
-- freeze node if the package that encloses the generic is inside
|
||||
-- the body that encloses the instance, because the freeze node
|
||||
-- would be in the wrong scope. Additional contortions needed if
|
||||
-- the bodies are within a subunit.
|
||||
-- frozen we have to assume it is at the proper place. This may be a
|
||||
-- potential ABE that requires dynamic checking. Do not add a freeze
|
||||
-- node if the package that encloses the generic is inside the body
|
||||
-- that encloses the instance, because the freeze node would be in
|
||||
-- the wrong scope. Additional contortions needed if the bodies are
|
||||
-- within a subunit.
|
||||
|
||||
declare
|
||||
Enclosing_Body : Node_Id;
|
||||
|
|
@ -6921,14 +6918,13 @@ package body Sem_Ch12 is
|
|||
-- investigated, and would allow this function to be significantly
|
||||
-- simplified. ???
|
||||
|
||||
if Present (Package_Instantiation (A)) then
|
||||
if Nkind (Package_Instantiation (A)) = N_Package_Instantiation then
|
||||
return Package_Instantiation (A);
|
||||
Inst := Package_Instantiation (A);
|
||||
if Present (Inst) then
|
||||
if Nkind (Inst) = N_Package_Instantiation then
|
||||
return Inst;
|
||||
|
||||
elsif Nkind (Original_Node (Package_Instantiation (A))) =
|
||||
N_Package_Instantiation
|
||||
then
|
||||
return Original_Node (Package_Instantiation (A));
|
||||
elsif Nkind (Original_Node (Inst)) = N_Package_Instantiation then
|
||||
return Original_Node (Inst);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
|
@ -7034,9 +7030,7 @@ package body Sem_Ch12 is
|
|||
-- now we depend on the user not redefining Standard itself in one of
|
||||
-- the parent units.
|
||||
|
||||
if Is_Immediately_Visible (C)
|
||||
and then C /= Standard_Standard
|
||||
then
|
||||
if Is_Immediately_Visible (C) and then C /= Standard_Standard then
|
||||
Set_Is_Immediately_Visible (C, False);
|
||||
Append_Elmt (C, Hidden_Entities);
|
||||
end if;
|
||||
|
|
@ -7143,8 +7137,7 @@ package body Sem_Ch12 is
|
|||
-- might produce false positives in rare cases, but guarantees
|
||||
-- that we produce all the instance bodies we will need.
|
||||
|
||||
if (Is_Entity_Name (Nam)
|
||||
and then Chars (Nam) = Chars (E))
|
||||
if (Is_Entity_Name (Nam) and then Chars (Nam) = Chars (E))
|
||||
or else (Nkind (Nam) = N_Selected_Component
|
||||
and then Chars (Selector_Name (Nam)) = Chars (E))
|
||||
then
|
||||
|
|
@ -7321,8 +7314,8 @@ package body Sem_Ch12 is
|
|||
|
||||
begin
|
||||
|
||||
-- If the body is a subunit, the freeze point is the corresponding
|
||||
-- stub in the current compilation, not the subunit itself.
|
||||
-- If the body is a subunit, the freeze point is the corresponding stub
|
||||
-- in the current compilation, not the subunit itself.
|
||||
|
||||
if Nkind (Parent (Gen_Body)) = N_Subunit then
|
||||
Orig_Body := Corresponding_Stub (Parent (Gen_Body));
|
||||
|
|
|
|||
|
|
@ -6423,8 +6423,9 @@ package body Sem_Ch6 is
|
|||
|
||||
-- If the body already exists, then this is an error unless
|
||||
-- the previous declaration is the implicit declaration of a
|
||||
-- derived subprogram, or this is a spurious overloading in an
|
||||
-- instance.
|
||||
-- derived subprogram. It is also legal for an instance to
|
||||
-- contain type conformant overloadable declarations (but the
|
||||
-- generic declaration may not), per 8.3(26/2).
|
||||
|
||||
elsif No (Alias (E))
|
||||
and then not Is_Intrinsic_Subprogram (E)
|
||||
|
|
|
|||
Loading…
Reference in New Issue