+2015-01-07 Robert Dewar <dewar@adacore.com>
+
+ * a-reatim.adb, make.adb, exp_pakd.adb, i-cpoint.adb, sem_ch8.adb,
+ exp_ch3.adb: Minor reformatting.
+
+2015-01-07 Doug Rupp <rupp@adacore.com>
+
+ * s-linux.ads (clockid_t): New subtype.
+ * s-osinte-linux.ads (pragma Linker Options): Add -lrt.
+ (clockid_t): New subtype.
+ (clock_getres): Import system call.
+ * s-taprop-linux.adb (System.OS_Constants): With and rename.
+ (RT_Resolution): Remove
+ hardcoded value and call clock_getres.
+ * s-linux-sparc.ads, s-linux-mipsel.ads, s-linux-hppa.ads,
+ s-linux-alpha.ads, s-linux-x32.ads (clockid_t): Add new subtype.
+
+2015-01-07 Robert Dewar <dewar@adacore.com>
+
+ * sem_warn.adb (Check_One_Unit): Guard against context item
+ with no Entity field.
+
2015-01-07 Vincent Celier <celier@adacore.com>
* clean.adb (Gnatclean): Warn that 'gnatclean -P' is obsolete.
-- the intermediate result Time (SC) we take advantage of the different
-- signs in SC and TS (when that is the case).
- -- If signs of SC and TS are different then we avoid converting SC to
- -- Time (as we do in the else part). The reason for that is that SC
+ -- If the signs of SC and TS are different then we avoid converting SC
+ -- to Time (as we do in the else part). The reason for that is that SC
-- converted to Time may overflow the range of Time, while the addition
-- of SC plus TS does not overflow (because of their different signs).
-- The approach is to add and remove the greatest value of time
-- signs, so we add the positive constant to the negative value, and the
-- negative constant to the positive value, to prevent overflows.
- if (SC > 0 and then TS < 0.0)
- or else (SC < 0 and then TS > 0.0)
- then
+ if (SC > 0 and then TS < 0.0) or else (SC < 0 and then TS > 0.0) then
declare
Closest_Boundary : constant Seconds_Count :=
(if TS >= 0.0 then
declare
Parent_IP : constant Name_Id :=
Make_Init_Proc_Name (Etype (Rec_Ent));
- Stmt : Node_Id := First (Stmts);
- IP_Call : Node_Id := Empty;
+ Stmt : Node_Id;
+ IP_Call : Node_Id;
IP_Stmts : List_Id;
begin
-- Look for a call to the parent IP at the beginning
-- of Stmts associated with the record extension
+ Stmt := First (Stmts);
+ IP_Call := Empty;
while Present (Stmt) loop
if Nkind (Stmt) = N_Procedure_Call_Statement
and then Chars (Name (Stmt)) = Parent_IP
elsif not Is_Constrained (Typ) then
-- When generating standard DWARF, the ___XP suffix will be stripped
- -- by the back-end, but generate it anyway to ease compiler
- -- debugging: this will help to distinguish implementation types from
- -- original packed arrays.
+ -- by the back-end but generate it anyway to ease compiler debugging.
+ -- This will help to distinguish implementation types from original
+ -- packed arrays.
PAT :=
Make_Defining_Identifier (Loc,
is
L : ptrdiff_t;
S : Pointer := Source;
+
begin
if Source = null or Target = null then
raise Dereference_Error;
end if;
-- Compute array length (including the terminator)
+
L := 1;
while S.all /= Terminator and then L < Limit loop
L := L + 1;
if Project_File_Name /= null then
Write_Line
- ("warning: gnatmake -P is obsolete and will not be available " &
- "in the next release. Use gprbuild instead.");
+ ("warning: gnatmake -P is obsolete and will not be available "
+ & "in the next release; use gprbuild instead");
end if;
-- If --subdirs= is specified, but not -P, this is equivalent to -D,
subtype long is Interfaces.C.long;
subtype suseconds_t is Interfaces.C.long;
subtype time_t is Interfaces.C.long;
+ subtype clockid_t is Interfaces.C.int;
type timespec is record
tv_sec : time_t;
subtype long is Interfaces.C.long;
subtype suseconds_t is Interfaces.C.long;
subtype time_t is Interfaces.C.long;
+ subtype clockid_t is Interfaces.C.int;
type timespec is record
tv_sec : time_t;
subtype long is Interfaces.C.long;
subtype suseconds_t is Interfaces.C.long;
subtype time_t is Interfaces.C.long;
+ subtype clockid_t is Interfaces.C.int;
type timespec is record
tv_sec : time_t;
subtype long is Interfaces.C.long;
subtype suseconds_t is Interfaces.C.long;
subtype time_t is Interfaces.C.long;
+ subtype clockid_t is Interfaces.C.int;
type timespec is record
tv_sec : time_t;
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package
+with Interfaces.C;
+
package System.Linux is
pragma Preelaborate;
-- Time --
----------
- type time_t is new Long_Long_Integer;
+ type time_t is new Long_Long_Integer;
+ subtype clockid_t is Interfaces.C.int;
type timespec is record
tv_sec : time_t;
subtype long is Interfaces.C.long;
subtype suseconds_t is Interfaces.C.long;
subtype time_t is Interfaces.C.long;
+ subtype clockid_t is Interfaces.C.int;
type timespec is record
tv_sec : time_t;
pragma Preelaborate;
pragma Linker_Options ("-lpthread");
+ pragma Linker_Options ("-lrt");
+ -- Needed for clock_getres with glibc versions prior to 2.17
subtype int is Interfaces.C.int;
subtype char is Interfaces.C.char;
-- Time --
----------
- subtype time_t is System.Linux.time_t;
- subtype timespec is System.Linux.timespec;
- subtype timeval is System.Linux.timeval;
+ subtype time_t is System.Linux.time_t;
+ subtype timespec is System.Linux.timespec;
+ subtype timeval is System.Linux.timeval;
+ subtype clockid_t is System.Linux.clockid_t;
+
+ function clock_getres
+ (clock_id : clockid_t;
+ res : access timespec) return int;
+ pragma Import (C, clock_getres, "clock_getres");
function To_Duration (TS : timespec) return Duration;
pragma Inline (To_Duration);
with System.Task_Info;
with System.Tasking.Debug;
with System.Interrupt_Management;
+with System.OS_Constants;
with System.OS_Primitives;
with System.Stack_Checking.Operations;
with System.Multiprocessors;
package body System.Task_Primitives.Operations is
+ package OSC renames System.OS_Constants;
package SSL renames System.Soft_Links;
package SC renames System.Stack_Checking.Operations;
-------------------
function RT_Resolution return Duration is
+ TS : aliased timespec;
+ Result : int;
begin
- return 10#1.0#E-6;
+ Result := clock_getres (OSC.CLOCK_REALTIME, TS'Unchecked_Access);
+ pragma Assert (Result = 0);
+
+ return To_Duration (TS);
end RT_Resolution;
------------
-- Check whether the renaming is for a defaulted actual subprogram
-- with a class-wide actual.
- -- The class-wide wrapper is not needed when we are in
- -- GNATprove_Mode and there is an external axiomatization on the
- -- package.
+ -- The class-wide wrapper is not needed in GNATprove_Mode and there
+ -- is an external axiomatization on the package.
if CW_Actual
and then Box_Present (Inst_Node)
- and then not (GNATprove_Mode
- and then
- Present (Containing_Package_With_Ext_Axioms
- (Formal_Spec)))
+ and then not
+ (GNATprove_Mode
+ and then
+ Present (Containing_Package_With_Ext_Axioms (Formal_Spec)))
then
Build_Class_Wide_Wrapper (New_S, Old_S);
if Nkind (Item) = N_With_Clause
and then not Implicit_With (Item)
and then In_Extended_Main_Source_Unit (Item)
+
+ -- Guard for no entity present. Not clear under what conditions
+ -- this happens, but it does occur, and since this is only a
+ -- warning, we just suppress the warning in this case.
+
+ and then Nkind (Name (Item)) in N_Has_Entity
+ and then Present (Entity (Name (Item)))
then
Lunit := Entity (Name (Item));
projects / gcc.git / commitdiff