Commit 1c85591c by Arnaud Charlet

[multiple changes]

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.

From-SVN: r219289
parent b6e5a1ec
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> 2015-01-07 Vincent Celier <celier@adacore.com>
* clean.adb (Gnatclean): Warn that 'gnatclean -P' is obsolete. * clean.adb (Gnatclean): Warn that 'gnatclean -P' is obsolete.
......
...@@ -222,8 +222,8 @@ package body Ada.Real_Time is ...@@ -222,8 +222,8 @@ package body Ada.Real_Time is
-- the intermediate result Time (SC) we take advantage of the different -- the intermediate result Time (SC) we take advantage of the different
-- signs in SC and TS (when that is the case). -- signs in SC and TS (when that is the case).
-- If signs of SC and TS are different then we avoid converting SC to -- If the signs of SC and TS are different then we avoid converting SC
-- Time (as we do in the else part). The reason for that is that 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 -- converted to Time may overflow the range of Time, while the addition
-- of SC plus TS does not overflow (because of their different signs). -- of SC plus TS does not overflow (because of their different signs).
-- The approach is to add and remove the greatest value of time -- The approach is to add and remove the greatest value of time
...@@ -231,9 +231,7 @@ package body Ada.Real_Time is ...@@ -231,9 +231,7 @@ package body Ada.Real_Time is
-- signs, so we add the positive constant to the negative value, and the -- signs, so we add the positive constant to the negative value, and the
-- negative constant to the positive value, to prevent overflows. -- negative constant to the positive value, to prevent overflows.
if (SC > 0 and then TS < 0.0) if (SC > 0 and then TS < 0.0) or else (SC < 0 and then TS > 0.0) then
or else (SC < 0 and then TS > 0.0)
then
declare declare
Closest_Boundary : constant Seconds_Count := Closest_Boundary : constant Seconds_Count :=
(if TS >= 0.0 then (if TS >= 0.0 then
......
...@@ -2395,14 +2395,16 @@ package body Exp_Ch3 is ...@@ -2395,14 +2395,16 @@ package body Exp_Ch3 is
declare declare
Parent_IP : constant Name_Id := Parent_IP : constant Name_Id :=
Make_Init_Proc_Name (Etype (Rec_Ent)); Make_Init_Proc_Name (Etype (Rec_Ent));
Stmt : Node_Id := First (Stmts); Stmt : Node_Id;
IP_Call : Node_Id := Empty; IP_Call : Node_Id;
IP_Stmts : List_Id; IP_Stmts : List_Id;
begin begin
-- Look for a call to the parent IP at the beginning -- Look for a call to the parent IP at the beginning
-- of Stmts associated with the record extension -- of Stmts associated with the record extension
Stmt := First (Stmts);
IP_Call := Empty;
while Present (Stmt) loop while Present (Stmt) loop
if Nkind (Stmt) = N_Procedure_Call_Statement if Nkind (Stmt) = N_Procedure_Call_Statement
and then Chars (Name (Stmt)) = Parent_IP and then Chars (Name (Stmt)) = Parent_IP
......
...@@ -765,9 +765,9 @@ package body Exp_Pakd is ...@@ -765,9 +765,9 @@ package body Exp_Pakd is
elsif not Is_Constrained (Typ) then elsif not Is_Constrained (Typ) then
-- When generating standard DWARF, the ___XP suffix will be stripped -- When generating standard DWARF, the ___XP suffix will be stripped
-- by the back-end, but generate it anyway to ease compiler -- by the back-end but generate it anyway to ease compiler debugging.
-- debugging: this will help to distinguish implementation types from -- This will help to distinguish implementation types from original
-- original packed arrays. -- packed arrays.
PAT := PAT :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
......
...@@ -145,12 +145,14 @@ package body Interfaces.C.Pointers is ...@@ -145,12 +145,14 @@ package body Interfaces.C.Pointers is
is is
L : ptrdiff_t; L : ptrdiff_t;
S : Pointer := Source; S : Pointer := Source;
begin begin
if Source = null or Target = null then if Source = null or Target = null then
raise Dereference_Error; raise Dereference_Error;
end if; end if;
-- Compute array length (including the terminator) -- Compute array length (including the terminator)
L := 1; L := 1;
while S.all /= Terminator and then L < Limit loop while S.all /= Terminator and then L < Limit loop
L := L + 1; L := L + 1;
......
...@@ -6490,8 +6490,8 @@ package body Make is ...@@ -6490,8 +6490,8 @@ package body Make is
if Project_File_Name /= null then if Project_File_Name /= null then
Write_Line Write_Line
("warning: gnatmake -P is obsolete and will not be available " & ("warning: gnatmake -P is obsolete and will not be available "
"in the next release. Use gprbuild instead."); & "in the next release; use gprbuild instead");
end if; end if;
-- If --subdirs= is specified, but not -P, this is equivalent to -D, -- If --subdirs= is specified, but not -P, this is equivalent to -D,
......
...@@ -47,6 +47,7 @@ package System.Linux is ...@@ -47,6 +47,7 @@ package System.Linux is
subtype long is Interfaces.C.long; subtype long is Interfaces.C.long;
subtype suseconds_t is Interfaces.C.long; subtype suseconds_t is Interfaces.C.long;
subtype time_t is Interfaces.C.long; subtype time_t is Interfaces.C.long;
subtype clockid_t is Interfaces.C.int;
type timespec is record type timespec is record
tv_sec : time_t; tv_sec : time_t;
......
...@@ -47,6 +47,7 @@ package System.Linux is ...@@ -47,6 +47,7 @@ package System.Linux is
subtype long is Interfaces.C.long; subtype long is Interfaces.C.long;
subtype suseconds_t is Interfaces.C.long; subtype suseconds_t is Interfaces.C.long;
subtype time_t is Interfaces.C.long; subtype time_t is Interfaces.C.long;
subtype clockid_t is Interfaces.C.int;
type timespec is record type timespec is record
tv_sec : time_t; tv_sec : time_t;
......
...@@ -46,6 +46,7 @@ package System.Linux is ...@@ -46,6 +46,7 @@ package System.Linux is
subtype long is Interfaces.C.long; subtype long is Interfaces.C.long;
subtype suseconds_t is Interfaces.C.long; subtype suseconds_t is Interfaces.C.long;
subtype time_t is Interfaces.C.long; subtype time_t is Interfaces.C.long;
subtype clockid_t is Interfaces.C.int;
type timespec is record type timespec is record
tv_sec : time_t; tv_sec : time_t;
......
...@@ -47,6 +47,7 @@ package System.Linux is ...@@ -47,6 +47,7 @@ package System.Linux is
subtype long is Interfaces.C.long; subtype long is Interfaces.C.long;
subtype suseconds_t is Interfaces.C.long; subtype suseconds_t is Interfaces.C.long;
subtype time_t is Interfaces.C.long; subtype time_t is Interfaces.C.long;
subtype clockid_t is Interfaces.C.int;
type timespec is record type timespec is record
tv_sec : time_t; tv_sec : time_t;
......
...@@ -36,6 +36,8 @@ ...@@ -36,6 +36,8 @@
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma -- 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 -- Preelaborate. This package is designed to be a bottom-level (leaf) package
with Interfaces.C;
package System.Linux is package System.Linux is
pragma Preelaborate; pragma Preelaborate;
...@@ -43,7 +45,8 @@ package System.Linux is ...@@ -43,7 +45,8 @@ package System.Linux is
-- Time -- -- 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 type timespec is record
tv_sec : time_t; tv_sec : time_t;
......
...@@ -47,6 +47,7 @@ package System.Linux is ...@@ -47,6 +47,7 @@ package System.Linux is
subtype long is Interfaces.C.long; subtype long is Interfaces.C.long;
subtype suseconds_t is Interfaces.C.long; subtype suseconds_t is Interfaces.C.long;
subtype time_t is Interfaces.C.long; subtype time_t is Interfaces.C.long;
subtype clockid_t is Interfaces.C.int;
type timespec is record type timespec is record
tv_sec : time_t; tv_sec : time_t;
......
...@@ -47,6 +47,8 @@ package System.OS_Interface is ...@@ -47,6 +47,8 @@ package System.OS_Interface is
pragma Preelaborate; pragma Preelaborate;
pragma Linker_Options ("-lpthread"); 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 int is Interfaces.C.int;
subtype char is Interfaces.C.char; subtype char is Interfaces.C.char;
...@@ -217,9 +219,15 @@ package System.OS_Interface is ...@@ -217,9 +219,15 @@ package System.OS_Interface is
-- Time -- -- Time --
---------- ----------
subtype time_t is System.Linux.time_t; subtype time_t is System.Linux.time_t;
subtype timespec is System.Linux.timespec; subtype timespec is System.Linux.timespec;
subtype timeval is System.Linux.timeval; 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; function To_Duration (TS : timespec) return Duration;
pragma Inline (To_Duration); pragma Inline (To_Duration);
......
...@@ -44,6 +44,7 @@ with Interfaces.C.Extensions; ...@@ -44,6 +44,7 @@ with Interfaces.C.Extensions;
with System.Task_Info; with System.Task_Info;
with System.Tasking.Debug; with System.Tasking.Debug;
with System.Interrupt_Management; with System.Interrupt_Management;
with System.OS_Constants;
with System.OS_Primitives; with System.OS_Primitives;
with System.Stack_Checking.Operations; with System.Stack_Checking.Operations;
with System.Multiprocessors; with System.Multiprocessors;
...@@ -56,6 +57,7 @@ with System.Soft_Links; ...@@ -56,6 +57,7 @@ with System.Soft_Links;
package body System.Task_Primitives.Operations is package body System.Task_Primitives.Operations is
package OSC renames System.OS_Constants;
package SSL renames System.Soft_Links; package SSL renames System.Soft_Links;
package SC renames System.Stack_Checking.Operations; package SC renames System.Stack_Checking.Operations;
...@@ -658,8 +660,13 @@ package body System.Task_Primitives.Operations is ...@@ -658,8 +660,13 @@ package body System.Task_Primitives.Operations is
------------------- -------------------
function RT_Resolution return Duration is function RT_Resolution return Duration is
TS : aliased timespec;
Result : int;
begin 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; end RT_Resolution;
------------ ------------
......
...@@ -2710,16 +2710,15 @@ package body Sem_Ch8 is ...@@ -2710,16 +2710,15 @@ package body Sem_Ch8 is
-- Check whether the renaming is for a defaulted actual subprogram -- Check whether the renaming is for a defaulted actual subprogram
-- with a class-wide actual. -- with a class-wide actual.
-- The class-wide wrapper is not needed when we are in -- The class-wide wrapper is not needed in GNATprove_Mode and there
-- GNATprove_Mode and there is an external axiomatization on the -- is an external axiomatization on the package.
-- package.
if CW_Actual if CW_Actual
and then Box_Present (Inst_Node) and then Box_Present (Inst_Node)
and then not (GNATprove_Mode and then not
and then (GNATprove_Mode
Present (Containing_Package_With_Ext_Axioms and then
(Formal_Spec))) Present (Containing_Package_With_Ext_Axioms (Formal_Spec)))
then then
Build_Class_Wide_Wrapper (New_S, Old_S); Build_Class_Wide_Wrapper (New_S, Old_S);
......
...@@ -2350,6 +2350,13 @@ package body Sem_Warn is ...@@ -2350,6 +2350,13 @@ package body Sem_Warn is
if Nkind (Item) = N_With_Clause if Nkind (Item) = N_With_Clause
and then not Implicit_With (Item) and then not Implicit_With (Item)
and then In_Extended_Main_Source_Unit (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 then
Lunit := Entity (Name (Item)); Lunit := Entity (Name (Item));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment