+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.
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;
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;
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);
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;
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;
-- --
-- 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- --
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
-- 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);
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
end if;
STPO.Unlock (Acceptor);
-
- if Parent_Locked then
- STPO.Unlock (Parent);
- end if;
+ STPO.Unlock (Parent);
end if;
return True;
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);
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
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)
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;
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
-- 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;
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;
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
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
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)
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));
-- 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;
-- 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;
-- 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;
-- 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
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));
-- 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)
projects / gcc.git / commitdiff