+2010-10-04 Arnaud Charlet <charlet@adacore.com>
+
+ * s-taprop-mingw.adb (Create_Task): Initialize Thread_Id field to 0.
+
+2010-10-04 Robert Dewar <dewar@adacore.com>
+
+ * exp_cg.adb: Minor code reorganization
+ Minor reformatting.
+ * exp_ch5.adb, prj-nmsc.adb: Minor reformatting.
+
2010-10-04 Bob Duff <duff@adacore.com>
* sem_res.adb (Resolve_Type_Conversion): If a type conversion is needed
---------------------------
function Homonym_Suffix_Length (E : Entity_Id) return Natural is
- Prefix_Length : constant := 2; -- Length of prefix "__"
+ Prefix_Length : constant := 2;
+ -- Length of prefix "__"
H : Entity_Id;
Nr : Nat := 1;
else
declare
Result : Natural := Prefix_Length + 1;
+
begin
while Nr >= 10 loop
Result := Result + 1;
Nr := Nr / 10;
end loop;
+
return Result;
end;
end if;
-- Local variables
Full_Name : constant String := Get_Name_String (Chars (E));
- Suffix_Length : Natural := Homonym_Suffix_Length (E);
+ Suffix_Length : Natural;
TSS_Name : TSS_Name_Type;
-- Start of processing for Is_Predefined_Dispatching_Operation
-- Search for and strip suffix for body-nested package entities
+ Suffix_Length := Homonym_Suffix_Length (E);
for J in reverse Full_Name'First + 2 .. Full_Name'Last loop
if Full_Name (J) = 'X' then
begin
Result := New_List;
-
Item := First (CI);
while Present (Item) loop
Recursive_Dirs.Reset (Visited);
end Find_Source_Dirs;
+ -- Local declarations
+
Dir_Exists : Boolean;
No_Sources : constant Boolean :=
- (((not Source_Files.Default) and then Source_Files.Values = Nil_String)
- or else
- ((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String)
- or else
- ((not Languages.Default) and then Languages.Values = Nil_String))
- and then Project.Extends = No_Project;
+ ((not Source_Files.Default
+ and then Source_Files.Values = Nil_String)
+ or else
+ (not Source_Dirs.Default
+ and then Source_Dirs.Values = Nil_String)
+ or else
+ (not Languages.Default
+ and then Languages.Values = Nil_String))
+ and then Project.Extends = No_Project;
-- Start of processing for Get_Directories
Object_Dir.Location, Project);
elsif not No_Sources then
+
-- We check that the specified object directory does exist.
-- However, even when it doesn't exist, we set it to a default
-- value. This is for the benefit of tools that recover from
if not Dir_Exists
and then not Project.Externally_Built
then
- -- The object directory does not exist, report an error if
- -- the project is not externally built.
+ -- The object directory does not exist, report an error if the
+ -- project is not externally built.
Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Object_Dir.Value);
Exec_Dir.Location, Project);
elsif not No_Sources then
+
-- We check that the specified exec directory does exist
Locate_Directory
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
T.Common.LL.Thread := hTask;
+ -- Note: it would be useful to initialize Thread_Id right away to avoid
+ -- a race condition in gdb where Thread_ID may not have the right value
+ -- yet, but GetThreadId is a Vista specific API, not available under XP:
+ -- T.Common.LL.Thread_Id := GetThreadId (hTask); so instead we set the
+ -- field to 0 to avoid having a random value. Thread_Id is initialized
+ -- in Enter_Task anyway.
+
+ T.Common.LL.Thread_Id := 0;
+
-- Step 3: set its priority (child has inherited priority from parent)
Set_Priority (T, Priority);
or else Get_Policy (Priority) = 'F'
then
-- Here we need Annex D semantics so we disable the NT priority
- -- boost. A priority boost is temporarily given by the system to a
- -- thread when it is taken out of a wait state.
+ -- boost. A priority boost is temporarily given by the system to
+ -- a thread when it is taken out of a wait state.
SetThreadPriorityBoost (hTask, DisablePriorityBoost => Win32.TRUE);
end if;
end if;
end if;
- -- Step 5: Now, start it for good:
+ -- Step 5: Now, start it for good
Result := ResumeThread (hTask);
pragma Assert (Result = 1);
procedure Finalize (S : in out Suspension_Object) is
Result : BOOL;
+
begin
-- Destroy internal mutex
procedure Suspend_Until_True (S : in out Suspension_Object) is
Result : DWORD;
Result_Bool : BOOL;
+
begin
SSL.Abort_Defer.all;