2010-10-04 Arnaud Charlet <charlet@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 4 Oct 2010 13:46:35 +0000 (13:46 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 4 Oct 2010 13:46:35 +0000 (13:46 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164937 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/exp_cg.adb
gcc/ada/exp_ch5.adb
gcc/ada/prj-nmsc.adb
gcc/ada/s-taprop-mingw.adb

index c06dd65..b389fed 100644 (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>
 
        * sem_res.adb (Resolve_Type_Conversion): If a type conversion is needed
index 004cf44..6db3929 100644 (file)
@@ -173,7 +173,8 @@ package body Exp_CG 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;
          Nr : Nat := 1;
@@ -200,11 +201,13 @@ package body Exp_CG is
             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;
@@ -214,7 +217,7 @@ package body Exp_CG is
       --  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
@@ -226,6 +229,7 @@ package body Exp_CG is
 
       --  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
 
index 7eaa30e..18bda5d 100644 (file)
@@ -1370,7 +1370,6 @@ package body Exp_Ch5 is
 
          begin
             Result := New_List;
-
             Item := First (CI);
             while Present (Item) loop
 
index babb17d..68c1849 100644 (file)
@@ -5280,15 +5280,20 @@ package body Prj.Nmsc is
          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
 
@@ -5318,6 +5323,7 @@ package body Prj.Nmsc is
                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
@@ -5338,8 +5344,8 @@ package body Prj.Nmsc is
             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);
@@ -5389,6 +5395,7 @@ package body Prj.Nmsc is
                Exec_Dir.Location, Project);
 
          elsif not No_Sources then
+
             --  We check that the specified exec directory does exist
 
             Locate_Directory
index a3b19ab..2339e52 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  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- --
@@ -918,6 +918,15 @@ package body System.Task_Primitives.Operations is
 
       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);
@@ -927,8 +936,8 @@ package body System.Task_Primitives.Operations is
         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
+         --  thread when it is taken out of a wait state.
 
          SetThreadPriorityBoost (hTask, DisablePriorityBoost => Win32.TRUE);
       end if;
@@ -942,7 +951,7 @@ package body System.Task_Primitives.Operations is
          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);
@@ -1122,6 +1131,7 @@ package body System.Task_Primitives.Operations is
 
    procedure Finalize (S : in out Suspension_Object) is
       Result : BOOL;
+
    begin
       --  Destroy internal mutex
 
@@ -1200,6 +1210,7 @@ package body System.Task_Primitives.Operations is
    procedure Suspend_Until_True (S : in out Suspension_Object) is
       Result      : DWORD;
       Result_Bool : BOOL;
+
    begin
       SSL.Abort_Defer.all;