[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

6 files changed, 94 insertions, 21 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 42a6331..4693dd4 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/a-strsea.adb b/gcc/ada/a-strsea.adb
index a9093ed..dbeb0e4 100644
--- a/gcc/ada/a-strsea.adb
+++ b/gcc/ada/a-strsea.adb
@@ -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
diff --git a/gcc/ada/a-stwise.adb b/gcc/ada/a-stwise.adb
index 3add82b..852b781 100644
--- a/gcc/ada/a-stwise.adb
+++ b/gcc/ada/a-stwise.adb
@@ -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
diff --git a/gcc/ada/a-stzsea.adb b/gcc/ada/a-stzsea.adb
index a9743e6..d6341ae 100644
--- a/gcc/ada/a-stzsea.adb
+++ b/gcc/ada/a-stzsea.adb
@@ -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
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index be323be..aa5b101 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -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;
diff --git a/gcc/ada/s-osprim-mingw.adb b/gcc/ada/s-osprim-mingw.adb
index 8285271..0984f49 100644
--- a/gcc/ada/s-osprim-mingw.adb
+++ b/gcc/ada/s-osprim-mingw.adb
@@ -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.
+
+      --  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.
 
-         if QueryPerformanceCounter (Base_Ticks'Access) = Win32.FALSE then
+      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