[multiple changes]

2009-07-07  Robert Dewar  <dewar@adacore.com>

	* prj-nmsc.adb: Minor reformatting

2009-07-07  Pascal Obry  <obry@adacore.com>

	* a-stwise.adb, a-stzsea.adb, a-strsea.adb (Index): properly handle
	cases where Pattern is longer than Source.

2009-07-07  Pascal Obry  <obry@adacore.com>

	* s-osprim-mingw.adb (Get_Base_Time): Avoid infinite loop.

From-SVN: r149326
This commit is contained in:
Arnaud Charlet 2009-07-07 15:17:29 +02:00
parent 54ecb428e7
commit 85686ad98b
6 changed files with 94 additions and 21 deletions

View File

@ -1,3 +1,16 @@
2009-07-07 Robert Dewar <dewar@adacore.com>
* prj-nmsc.adb: Minor reformatting
2009-07-07 Pascal Obry <obry@adacore.com>
* a-stwise.adb, a-stzsea.adb, a-strsea.adb (Index): properly handle
cases where Pattern is longer than Source.
2009-07-07 Pascal Obry <obry@adacore.com>
* s-osprim-mingw.adb (Get_Base_Time): Avoid infinite loop.
2009-07-07 Emmanuel Briot <briot@adacore.com>
* prj-nmsc.adb (Process_Naming): canonicalize file suffixes read in the

View File

@ -246,6 +246,12 @@ package body Ada.Strings.Search is
raise Pattern_Error;
end if;
-- If Pattern longer than Source it can't be found
if Pattern'Length > Source'Length then
return 0;
end if;
-- Forwards case
if Going = Forward then
@ -348,6 +354,12 @@ package body Ada.Strings.Search is
raise Constraint_Error;
end if;
-- If Pattern longer than Source it can't be found
if Pattern'Length > Source'Length then
return 0;
end if;
-- Forwards case
if Going = Forward then

View File

@ -241,6 +241,12 @@ package body Ada.Strings.Wide_Search is
raise Pattern_Error;
end if;
-- If Pattern longer than Source it can't be found
if Pattern'Length > Source'Length then
return 0;
end if;
-- Forwards case
if Going = Forward then
@ -343,6 +349,12 @@ package body Ada.Strings.Wide_Search is
raise Constraint_Error;
end if;
-- If Pattern longer than Source it can't be found
if Pattern'Length > Source'Length then
return 0;
end if;
-- Forwards case
if Going = Forward then

View File

@ -245,6 +245,12 @@ package body Ada.Strings.Wide_Wide_Search is
raise Pattern_Error;
end if;
-- If Pattern longer than Source it can't be found
if Pattern'Length > Source'Length then
return 0;
end if;
-- Forwards case
if Going = Forward then
@ -348,6 +354,12 @@ package body Ada.Strings.Wide_Wide_Search is
raise Constraint_Error;
end if;
-- If Pattern longer than Source it can't be found
if Pattern'Length > Source'Length then
return 0;
end if;
-- Forwards case
if Going = Forward then

View File

@ -3358,26 +3358,27 @@ package body Prj.Nmsc is
----------------------------
procedure Initialize_Naming_Data is
Specs : Array_Element_Id :=
Util.Value_Of
(Name_Spec_Suffix,
Naming.Decl.Arrays,
In_Tree);
Impls : Array_Element_Id :=
Util.Value_Of
(Name_Body_Suffix,
Naming.Decl.Arrays,
In_Tree);
Specs : Array_Element_Id :=
Util.Value_Of
(Name_Spec_Suffix,
Naming.Decl.Arrays,
In_Tree);
Impls : Array_Element_Id :=
Util.Value_Of
(Name_Body_Suffix,
Naming.Decl.Arrays,
In_Tree);
Lang : Language_Ptr;
Lang_Name : Name_Id;
Value : Variable_Value;
Extended : Project_Id;
begin
-- At this stage, the project already contains the default
-- extensions for the various languages. We now merge those
-- suffixes read in the user project, and they override the
-- default
-- At this stage, the project already contains the default extensions
-- for the various languages. We now merge those suffixes read in the
-- user project, and they override the default.
while Specs /= No_Array_Element loop
Lang_Name := In_Tree.Array_Elements.Table (Specs).Index;

View File

@ -156,23 +156,38 @@ package body System.OS_Primitives is
-- Therefore, the elapsed time reported by GetSystemTime between both
-- actions should be null.
Max_Elapsed : constant := 0;
Test_Now : aliased Long_Long_Integer;
Max_Elapsed : constant := 0;
epoch_1970 : constant := 16#19D_B1DE_D53E_8000#; -- win32 UTC epoch
system_time_ns : constant := 100; -- 100 ns per tick
Sec_Unit : constant := 10#1#E9;
Test_Now : aliased Long_Long_Integer;
Loc_Ticks : aliased LARGE_INTEGER;
Loc_Time : aliased Long_Long_Integer;
Elapsed : Long_Long_Integer;
Current_Max : Long_Long_Integer := Long_Long_Integer'Last;
begin
-- Here we must be sure that both of these calls are done in a short
-- amount of time. Both are base time and should in theory be taken
-- at the very same time.
loop
GetSystemTimeAsFileTime (Base_Time'Access);
-- The goal of the following loop is to synchronize the system time
-- with the Win32 performance counter by getting a base offset for both.
-- Using these offsets it is then possible to compute actual time using
-- a performance counter which has a better precision than the Win32
-- time API.
if QueryPerformanceCounter (Base_Ticks'Access) = Win32.FALSE then
-- Try at most 10th times to reach the best synchronisation (below 1
-- millisecond) otherwise the runtime will use the best value
-- reached during the runs.
for K in 1 .. 10 loop
GetSystemTimeAsFileTime (Loc_Time'Access);
if QueryPerformanceCounter (Loc_Ticks'Access) = Win32.FALSE then
pragma Assert
(Standard.False,
"Could not query high performance counter in Clock");
@ -181,7 +196,15 @@ package body System.OS_Primitives is
GetSystemTimeAsFileTime (Test_Now'Access);
exit when Test_Now - Base_Time = Max_Elapsed;
Elapsed := Test_Now - Loc_Time;
if Elapsed < Current_Max then
Base_Time := Loc_Time;
Base_Ticks := Loc_Ticks;
Current_Max := Elapsed;
end if;
exit when Elapsed = Max_Elapsed;
end loop;
Base_Clock := Duration