+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
-- 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;
--------------------------
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))
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;
-- 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;
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;
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
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
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;
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;
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
-- 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- --
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 --
-------------
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");
-- --
-- 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- --
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
(Msg : String;
N : Node_Id;
Subp : Entity_Id;
- Is_Serious : Boolean := False) is
+ Is_Serious : Boolean := False)
+ is
begin
pragma Assert (Msg (Msg'Last) = '?');
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;
----------------------