[multiple changes]

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.

From-SVN: r164937
This commit is contained in:
Arnaud Charlet 2010-10-04 15:46:35 +02:00
parent 9db0b2326f
commit 39eb65425d
5 changed files with 46 additions and 15 deletions

View File

@ -1,3 +1,13 @@
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> 2010-10-04 Bob Duff <duff@adacore.com>
* sem_res.adb (Resolve_Type_Conversion): If a type conversion is needed * sem_res.adb (Resolve_Type_Conversion): If a type conversion is needed

View File

@ -173,7 +173,8 @@ package body Exp_CG is
--------------------------- ---------------------------
function Homonym_Suffix_Length (E : Entity_Id) return Natural is 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; H : Entity_Id;
Nr : Nat := 1; Nr : Nat := 1;
@ -200,11 +201,13 @@ package body Exp_CG is
else else
declare declare
Result : Natural := Prefix_Length + 1; Result : Natural := Prefix_Length + 1;
begin begin
while Nr >= 10 loop while Nr >= 10 loop
Result := Result + 1; Result := Result + 1;
Nr := Nr / 10; Nr := Nr / 10;
end loop; end loop;
return Result; return Result;
end; end;
end if; end if;
@ -214,7 +217,7 @@ package body Exp_CG is
-- Local variables -- Local variables
Full_Name : constant String := Get_Name_String (Chars (E)); Full_Name : constant String := Get_Name_String (Chars (E));
Suffix_Length : Natural := Homonym_Suffix_Length (E); Suffix_Length : Natural;
TSS_Name : TSS_Name_Type; TSS_Name : TSS_Name_Type;
-- Start of processing for Is_Predefined_Dispatching_Operation -- Start of processing for Is_Predefined_Dispatching_Operation
@ -226,6 +229,7 @@ package body Exp_CG is
-- Search for and strip suffix for body-nested package entities -- 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 for J in reverse Full_Name'First + 2 .. Full_Name'Last loop
if Full_Name (J) = 'X' then if Full_Name (J) = 'X' then

View File

@ -1370,7 +1370,6 @@ package body Exp_Ch5 is
begin begin
Result := New_List; Result := New_List;
Item := First (CI); Item := First (CI);
while Present (Item) loop while Present (Item) loop

View File

@ -5280,15 +5280,20 @@ package body Prj.Nmsc is
Recursive_Dirs.Reset (Visited); Recursive_Dirs.Reset (Visited);
end Find_Source_Dirs; end Find_Source_Dirs;
-- Local declarations
Dir_Exists : Boolean; Dir_Exists : Boolean;
No_Sources : constant Boolean := No_Sources : constant Boolean :=
(((not Source_Files.Default) and then Source_Files.Values = Nil_String) ((not Source_Files.Default
or else and then Source_Files.Values = Nil_String)
((not Source_Dirs.Default) and then Source_Dirs.Values = Nil_String) or else
or else (not Source_Dirs.Default
((not Languages.Default) and then Languages.Values = Nil_String)) and then Source_Dirs.Values = Nil_String)
and then Project.Extends = No_Project; or else
(not Languages.Default
and then Languages.Values = Nil_String))
and then Project.Extends = No_Project;
-- Start of processing for Get_Directories -- Start of processing for Get_Directories
@ -5318,6 +5323,7 @@ package body Prj.Nmsc is
Object_Dir.Location, Project); Object_Dir.Location, Project);
elsif not No_Sources then elsif not No_Sources then
-- We check that the specified object directory does exist. -- We check that the specified object directory does exist.
-- However, even when it doesn't exist, we set it to a default -- However, even when it doesn't exist, we set it to a default
-- value. This is for the benefit of tools that recover from -- value. This is for the benefit of tools that recover from
@ -5338,8 +5344,8 @@ package body Prj.Nmsc is
if not Dir_Exists if not Dir_Exists
and then not Project.Externally_Built and then not Project.Externally_Built
then then
-- The object directory does not exist, report an error if -- The object directory does not exist, report an error if the
-- the project is not externally built. -- project is not externally built.
Err_Vars.Error_Msg_File_1 := Err_Vars.Error_Msg_File_1 :=
File_Name_Type (Object_Dir.Value); File_Name_Type (Object_Dir.Value);
@ -5389,6 +5395,7 @@ package body Prj.Nmsc is
Exec_Dir.Location, Project); Exec_Dir.Location, Project);
elsif not No_Sources then elsif not No_Sources then
-- We check that the specified exec directory does exist -- We check that the specified exec directory does exist
Locate_Directory Locate_Directory

View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -918,6 +918,15 @@ package body System.Task_Primitives.Operations is
T.Common.LL.Thread := hTask; 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) -- Step 3: set its priority (child has inherited priority from parent)
Set_Priority (T, Priority); Set_Priority (T, Priority);
@ -927,8 +936,8 @@ package body System.Task_Primitives.Operations is
or else Get_Policy (Priority) = 'F' or else Get_Policy (Priority) = 'F'
then then
-- Here we need Annex D semantics so we disable the NT priority -- Here we need Annex D semantics so we disable the NT priority
-- boost. A priority boost is temporarily given by the system to a -- boost. A priority boost is temporarily given by the system to
-- thread when it is taken out of a wait state. -- a thread when it is taken out of a wait state.
SetThreadPriorityBoost (hTask, DisablePriorityBoost => Win32.TRUE); SetThreadPriorityBoost (hTask, DisablePriorityBoost => Win32.TRUE);
end if; end if;
@ -942,7 +951,7 @@ package body System.Task_Primitives.Operations is
end if; end if;
end if; end if;
-- Step 5: Now, start it for good: -- Step 5: Now, start it for good
Result := ResumeThread (hTask); Result := ResumeThread (hTask);
pragma Assert (Result = 1); pragma Assert (Result = 1);
@ -1122,6 +1131,7 @@ package body System.Task_Primitives.Operations is
procedure Finalize (S : in out Suspension_Object) is procedure Finalize (S : in out Suspension_Object) is
Result : BOOL; Result : BOOL;
begin begin
-- Destroy internal mutex -- Destroy internal mutex
@ -1200,6 +1210,7 @@ package body System.Task_Primitives.Operations is
procedure Suspend_Until_True (S : in out Suspension_Object) is procedure Suspend_Until_True (S : in out Suspension_Object) is
Result : DWORD; Result : DWORD;
Result_Bool : BOOL; Result_Bool : BOOL;
begin begin
SSL.Abort_Defer.all; SSL.Abort_Defer.all;