mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-04 19:11:19 +08:00
Code Issues Packages Projects Releases Wiki Activity

prj-util.ads, [...] (Relative_Path): New routine.

Browse Source 
2015-05-22  Pascal Obry  <obry@adacore.com>

	* prj-util.ads, prj-util.adb (Relative_Path): New routine.

From-SVN: r223542
This commit is contained in:
Pascal Obry 2015-05-22 10:38:07 +00:00 committed by Arnaud Charlet
parent ca81124179
commit 01099e0465
3 changed files with 78 additions and 2 deletions

4
gcc/ada/ChangeLog

@ -1,3 +1,7 @@
2015-05-22 Pascal Obry <obry@adacore.com>
* prj-util.ads, prj-util.adb (Relative_Path): New routine.
2015-05-22 Bob Duff <duff@adacore.com>
* exp_utils.ads, exp_utils.adb (Find_Optional_Prim_Op): New

70
gcc/ada/prj-util.adb

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -25,6 +25,8 @@
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Directories;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Strings.Maps; use Ada.Strings.Maps;
with Ada.Unchecked_Deallocation;
with GNAT.Case_Util; use GNAT.Case_Util;
@ -798,6 +800,71 @@ package body Prj.Util is
Put (File, L);
end Put_Line;
-------------------
-- Relative_Path --
-------------------
function Relative_Path (Pathname, To : String) return String is
function Ensure_Directory (Path : String) return String;
----------------------
-- Ensure_Directory --
----------------------
function Ensure_Directory (Path : String) return String is
begin
if Path'Length = 0
or else Path (Path'Last) = Directory_Separator
or else Path (Path'Last) = '/' -- on Windows check also for /
then
return Path;
else
return Path & Directory_Separator;
end if;
end Ensure_Directory;
Dir_Sep_Map : constant Character_Mapping := To_Mapping ("\", "/");
P : String (1 .. Pathname'Length) := Pathname;
T : String (1 .. To'Length) := To;
Pi : Natural; -- common prefix ending
N : Natural := 0;
begin
pragma Assert (Is_Absolute_Path (Pathname));
pragma Assert (Is_Absolute_Path (To));
-- Use canonical directory separator
Translate (Source => P, Mapping => Dir_Sep_Map);
Translate (Source => T, Mapping => Dir_Sep_Map);
-- First check for common prefix
Pi := 1;
while Pi < P'Last and then Pi < T'Last and then P (Pi) = T (Pi) loop
Pi := Pi + 1;
end loop;
-- Cut common prefix at a directory separator
while Pi > P'First and then P (Pi) /= '/' loop
Pi := Pi - 1;
end loop;
-- Count directory under prefix in P, these will be replaced by the
-- corresponding number of "..".
N := Count (T (Pi + 1 .. T'Last), "/");
if T (T'Last) /= '/' then
N := N + 1;
end if;
return N * "../" & Ensure_Directory (P (Pi + 1 .. P'Last));
end Relative_Path;
---------------------------
-- Read_Source_Info_File --
---------------------------
@ -1357,4 +1424,5 @@ package body Prj.Util is
Write_Str (S (First .. S'Last));
end if;
end Write_Str;
end Prj.Util;

6
gcc/ada/prj-util.ads

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2012, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -245,6 +245,10 @@ package Prj.Util is
-- are handled. This routine must be called only when the project has
-- been built successfully.
function Relative_Path (Pathname, To : String) return String;
-- Returns the relative pathname which corresponds to Pathname when
-- starting from directory to. Both Pathname and To must be absolute paths.
private
type Text_File_Data is record
FD : File_Descriptor := Invalid_FD;