[Ada] Fix constraint error in Normalize_Pathname

Fix Normalize_Pathname to avoid a constraint error.

2018-05-29  Pascal Obry  <obry@adacore.com>

gcc/ada/

	* libgnat/s-os_lib.adb (Normalize_Pathname): Fix handling of ".." in
	the root directory.

gcc/testsuite/

	* gnat.dg/normalize_pathname.adb: New testcase.

From-SVN: r260872

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 18a37dbf44ab7e13b1877f8133d4d2a38d33226f..6aea3c0b2a9774d0388d746f8f12f234394feaa0 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2018-05-29  Pascal Obry  <obry@adacore.com>
+
+       * libgnat/s-os_lib.adb (Normalize_Pathname): Fix handling of ".." in
+       the root directory.
+
 2018-05-29  Pascal Obry  <obry@adacore.com>
 
        * libgnat/s-os_lib.adb: Minor reformatting.

diff --git a/gcc/ada/libgnat/s-os_lib.adb b/gcc/ada/libgnat/s-os_lib.adb
index 7e839cc687a60d23768ad931e2506239733223b6..ca6eea18533a091b00f44d4eb419e515f6fa293c 100644 (file)
--- a/gcc/ada/libgnat/s-os_lib.adb
+++ b/gcc/ada/libgnat/s-os_lib.adb
@@ -2389,12 +2389,18 @@ package body System.OS_Lib is
          elsif Finish = Start + 1
            and then Path_Buffer (Start .. Finish) = ".."
          then
-            Start := Last;
-            loop
-               Start := Start - 1;
-               exit when Start = 1
-                 or else Path_Buffer (Start) = Directory_Separator;
-            end loop;
+            if Last > 1 then
+               Start := Last - 1;
+
+               while Start > 1
+                 and then Path_Buffer (Start) /= Directory_Separator
+               loop
+                  Start := Start - 1;
+               end loop;
+
+            else
+               Start := Last;
+            end if;
 
             if Start = 1 then
                if Finish = End_Path then

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b5f0e1f6d67285c46605164a7e4c72770b7df4fe..947dfc28565927f60bd2056935f95ed705ea31c9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-05-29  Pascal Obry  <obry@adacore.com>
+
+       * gnat.dg/normalize_pathname.adb: New testcase.
+
 2018-05-29  Tom de Vries  <tom@codesourcery.com>
 
        * lib/scanasm.exp (scan-assembler-times): Use proc name in error

diff --git a/gcc/testsuite/gnat.dg/normalize_pathname.adb b/gcc/testsuite/gnat.dg/normalize_pathname.adb
new file mode 100644 (file)
index 0000000..7d0bcb1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/normalize_pathname.adb
@@ -0,0 +1,10 @@
+--  { dg-do run }
+
+with GNAT.OS_Lib;
+
+procedure Normalize_Pathname is
+   S : constant String := GNAT.OS_Lib.Normalize_Pathname
+     ("/../tmp", Directory => "", Resolve_Links => True);
+begin
+   null;
+end Normalize_Pathname;