2012-03-07 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 7 Mar 2012 17:05:06 +0000 (17:05 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 7 Mar 2012 17:05:06 +0000 (17:05 +0000)
* sem_util.adb, exp_ch4.adb, exp_ch6.adb, sem_ch6.adb: Minor
reformatting.

2012-03-07  Sergey Rybin  <rybin@adacore.com frybin>

* gnat_ugn.texi: gnatpp: fix paragraph about sources with
preprocessor directives.

2012-03-07  Arnaud Charlet  <charlet@adacore.com>

* s-osinte-linux.ads, s-taprop-linux.adb (prctl): New function.
(Enter_Task): Call prctl when relevant.

2012-03-07  Tristan Gingold  <gingold@adacore.com>

* s-osinte-vms.ads: pthread_mutex_setname_np: new function.

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

gcc/ada/ChangeLog
gcc/ada/exp_ch4.adb
gcc/ada/exp_ch6.adb
gcc/ada/gnat_ugn.texi
gcc/ada/s-osinte-linux.ads
gcc/ada/s-osinte-vms.ads
gcc/ada/s-taprop-linux.adb
gcc/ada/sem_ch6.adb
gcc/ada/sem_util.adb

index 46068b7..74cd5cc 100644 (file)
@@ -1,3 +1,22 @@
+2012-03-07  Robert Dewar  <dewar@adacore.com>
+
+       * sem_util.adb, exp_ch4.adb, exp_ch6.adb, sem_ch6.adb: Minor
+       reformatting.
+
+2012-03-07  Sergey Rybin  <rybin@adacore.com frybin>
+
+       * gnat_ugn.texi: gnatpp: fix paragraph about sources with
+       preprocessor directives.
+
+2012-03-07  Arnaud Charlet  <charlet@adacore.com>
+
+       * s-osinte-linux.ads, s-taprop-linux.adb (prctl): New function.
+       (Enter_Task): Call prctl when relevant.
+
+2012-03-07  Tristan Gingold  <gingold@adacore.com>
+
+       * s-osinte-vms.ads: pthread_mutex_setname_np: new function.
+
 2012-03-07  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_ch6.adb (Process_Formals): a generic subprogram with
index dff4e3e..001b9ed 100644 (file)
@@ -3529,17 +3529,15 @@ package body Exp_Ch4 is
       --  Expand_Allocator_Expression inherit the proper type attributes.
 
       if (Ekind (PtrT) = E_Anonymous_Access_Type
-            or else
-              (Is_Itype (PtrT) and then No (Finalization_Master (PtrT))))
+           or else
+             (Is_Itype (PtrT) and then No (Finalization_Master (PtrT))))
         and then Needs_Finalization (Dtyp)
       then
          --  Anonymous access-to-controlled types allocate on the global pool.
          --  Do not set this attribute on .NET/JVM since those targets do not
          --  support pools.
 
-         if No (Associated_Storage_Pool (PtrT))
-           and then VM_Target = No_VM
-         then
+         if No (Associated_Storage_Pool (PtrT)) and then VM_Target = No_VM then
             Set_Associated_Storage_Pool
               (PtrT, Get_Global_Pool_For_Access_Type (PtrT));
          end if;
index 1d43e52..5afb31c 100644 (file)
@@ -2290,12 +2290,11 @@ package body Exp_Ch6 is
       --------------------------
 
       function In_Unfrozen_Instance (E : Entity_Id) return Boolean is
-         S : Entity_Id := E;
+         S : Entity_Id;
 
       begin
-         while Present (S)
-           and then S /= Standard_Standard
-         loop
+         S := E;
+         while Present (S) and then S /= Standard_Standard loop
             if Is_Generic_Instance (S)
               and then Present (Freeze_Node (S))
               and then not Analyzed (Freeze_Node (S))
@@ -2353,9 +2352,7 @@ package body Exp_Ch6 is
          Res : constant Node_Id := Duplicate_Subexpr (From);
       begin
          if Is_Access_Type (Etype (From)) then
-            return
-              Make_Explicit_Dereference (Sloc (From),
-                Prefix => Res);
+            return Make_Explicit_Dereference (Sloc (From), Prefix => Res);
          else
             return Res;
          end if;
@@ -3702,7 +3699,6 @@ package body Exp_Ch6 is
          --  Handle inlining (old semantics)
 
          if Is_Inlined (Subp) and then not Debug_Flag_Dot_K then
-
             Inlined_Subprogram : declare
                Bod         : Node_Id;
                Must_Inline : Boolean := False;
@@ -4078,7 +4074,7 @@ package body Exp_Ch6 is
 
       Targ : Node_Id;
       --  The target of the call. If context is an assignment statement then
-      --  this is the left-hand side of the assignment; else it is a temporary
+      --  this is the left-hand side of the assignment, else it is a temporary
       --  to which the return value is assigned prior to rewriting the call.
 
       Targ1 : Node_Id;
@@ -4115,8 +4111,8 @@ package body Exp_Ch6 is
       procedure Reset_Dispatching_Calls (N : Node_Id);
       --  In subtree N search for occurrences of dispatching calls that use the
       --  Ada 2005 Object.Operation notation and the object is a formal of the
-      --  inlined subprogram; in all the found occurrences reset the entity
-      --  associated with Operation.
+      --  inlined subprogram. Reset the entity associated with Operation in all
+      --  the found occurrences.
 
       procedure Rewrite_Function_Call (N : Node_Id; Blk : Node_Id);
       --  If the function body is a single expression, replace call with
@@ -4355,9 +4351,10 @@ package body Exp_Ch6 is
       procedure Reset_Dispatching_Calls (N : Node_Id) is
 
          function Do_Reset (N : Node_Id) return Traverse_Result;
+         --  Comment required ???
 
          --------------
-         -- Do_Check --
+         -- Do_Reset --
          --------------
 
          function Do_Reset (N : Node_Id) return Traverse_Result is
@@ -4377,10 +4374,13 @@ package body Exp_Ch6 is
 
          function Do_Reset_Calls is new Traverse_Func (Do_Reset);
 
-         --  Start of processing for Reset_Dispatching_Calls
+         --  Local variables
 
          Dummy : constant Traverse_Result := Do_Reset_Calls (N);
          pragma Unreferenced (Dummy);
+
+         --  Start of processing for Reset_Dispatching_Calls
+
       begin
          null;
       end Reset_Dispatching_Calls;
@@ -5073,8 +5073,7 @@ package body Exp_Ch6 is
 
       if Is_Unc_Decl then
 
-         --  No action needed since the return statement has been already
-         --  removed!
+         --  No action needed since return statement has been already removed!
 
          null;
 
index 4bd7bba..6885eed 100644 (file)
@@ -13045,12 +13045,8 @@ semantically legal.
 If this condition is not met, @command{gnatpp} will terminate with an
 error message; no output file will be generated.
 
-If the source files presented to @command{gnatpp} contain
-preprocessing directives, then the output file will
-correspond to the generated source after all
-preprocessing is carried out. There is no way
-using @command{gnatpp} to obtain pretty printed files that
-include the preprocessing directives.
+@command{gnatpp} cannot process sources that contain
+preprocessing directives.
 
 If the compilation unit
 contained in the input source depends semantically upon units located
index 3874866..31b4c72 100644 (file)
@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---          Copyright (C) 1995-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT 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- --
@@ -255,6 +255,12 @@ package System.OS_Interface is
    function getpid return pid_t;
    pragma Import (C, getpid, "getpid");
 
+   PR_SET_NAME : constant := 15;
+
+   function prctl
+     (option : int; arg2, arg3, arg4, arg5 : unsigned_long := 0) return int;
+   pragma Import (C, prctl);
+
    -------------
    -- Threads --
    -------------
index e24980e..cadc652 100644 (file)
@@ -449,6 +449,12 @@ package System.OS_Interface is
    function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int;
    pragma Import (C, pthread_mutex_unlock, "PTHREAD_MUTEX_UNLOCK");
 
+   function pthread_mutex_setname_np
+     (attr : access pthread_mutex_t;
+      name : System.Address;
+      mbz  : System.Address) return int;
+   pragma Import (C, pthread_mutex_setname_np, "PTHREAD_MUTEX_SETNAME_NP");
+
    function pthread_condattr_init
      (attr : access pthread_condattr_t) return int;
    pragma Import (C, pthread_condattr_init, "PTHREAD_CONDATTR_INIT");
index 4e69ea4..cf71082 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2011, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2012, 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- --
@@ -767,6 +767,22 @@ package body System.Task_Primitives.Operations is
       Self_ID.Common.LL.Thread := pthread_self;
       Self_ID.Common.LL.LWP := lwp_self;
 
+      if Self_ID.Common.Task_Image_Len > 0 then
+         declare
+            Task_Name : String (1 .. Parameters.Max_Task_Image_Length + 1);
+            Result    : int;
+         begin
+            --  Set thread name to ease debugging
+
+            Task_Name (1 .. Self_ID.Common.Task_Image_Len) :=
+              Self_ID.Common.Task_Image (1 .. Self_ID.Common.Task_Image_Len);
+            Task_Name (Self_ID.Common.Task_Image_Len + 1) := ASCII.NUL;
+
+            Result := prctl (PR_SET_NAME, unsigned_long (Task_Name'Address));
+            pragma Assert (Result = 0);
+         end;
+      end if;
+
       Specific.Set (Self_ID);
 
       if Use_Alternate_Stack
index 09d7597..57e0ccf 100644 (file)
@@ -4119,7 +4119,8 @@ package body Sem_Ch6 is
      (Msg        : String;
       N          : Node_Id;
       Subp       : Entity_Id;
-      Is_Serious : Boolean := False) is
+      Is_Serious : Boolean := False)
+   is
    begin
       pragma Assert (Msg (Msg'Last) = '?');
 
index 9ce15c5..87a9334 100644 (file)
@@ -9397,8 +9397,7 @@ package body Sem_Util is
    begin
       return Optimization_Level = 0
         and then Has_Pragma_Inline (Subp)
-        and then (Has_Pragma_Inline_Always (Subp)
-                    or else Front_End_Inlining);
+        and then (Has_Pragma_Inline_Always (Subp) or else Front_End_Inlining);
    end Must_Inline;
 
    ----------------------