• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1# Copyright 2002-2006. Vladimir Prus
2# Copyright 2003-2004. Dave Abrahams
3# Copyright 2003-2006. Rene Rivera
4# Distributed under the Boost Software License, Version 1.0.
5# (See accompanying file LICENSE_1_0.txt or copy at
6# http://www.boost.org/LICENSE_1_0.txt)
7
8# Performs various path manipulations. Paths are always in a 'normalized'
9# representation. In it, a path may be either:
10#
11#     - '.', or
12#
13#     - ['/'] [ ( '..' '/' )* (token '/')* token ]
14#
15# In plain english, path can be rooted, '..' elements are allowed only at the
16# beginning, and it never ends in slash, except for path consisting of slash
17# only.
18
19import modules ;
20import regex ;
21import sequence ;
22import set ;
23
24
25os = [ modules.peek : OS ] ;
26if [ modules.peek : UNIX ]
27{
28    local uname = [ modules.peek : JAMUNAME ] ;
29    switch $(uname)
30    {
31        case CYGWIN* : os = CYGWIN ;
32        case *       : os = UNIX ;
33    }
34}
35
36
37# Converts the native path into normalized form.
38#
39rule make ( native )
40{
41    return [ make-$(os) $(native) ] ;
42}
43
44
45# Builds native representation of the path.
46#
47rule native ( path )
48{
49    return [ native-$(os) $(path) ] ;
50}
51
52
53# Tests if a path is rooted.
54#
55rule is-rooted ( path )
56{
57    return [ MATCH "^(/)" : $(path) ] ;
58}
59
60
61# Tests if a path has a parent.
62#
63rule has-parent ( path )
64{
65    if $(path) != /
66    {
67        return 1 ;
68    }
69    else
70    {
71        return ;
72    }
73}
74
75
76# Returns the path without any directory components.
77#
78rule basename ( path )
79{
80    return [ MATCH "([^/]+)$" : $(path) ] ;
81}
82
83
84# Returns parent directory of the path. If no parent exists, error is issued.
85#
86rule parent ( path )
87{
88    if [ has-parent $(path) ]
89    {
90        if $(path) = .
91        {
92            return .. ;
93        }
94        else
95        {
96            # Strip everything at the end of path up to and including the last
97            # slash.
98            local result = [ regex.match "((.*)/)?([^/]+)" : $(path) : 2 3 ] ;
99
100            # Did we strip what we shouldn't?
101            if $(result[2]) = ".."
102            {
103                return $(path)/.. ;
104            }
105            else
106            {
107                if ! $(result[1])
108                {
109                    if [ is-rooted $(path) ]
110                    {
111                        result = / ;
112                    }
113                    else
114                    {
115                        result = . ;
116                    }
117                }
118                return $(result[1]) ;
119            }
120        }
121    }
122    else
123    {
124        import errors ;
125        errors.error "Path '$(path)' has no parent" ;
126    }
127}
128
129
130# Returns path2 such that "[ join path path2 ] = .". The path may not contain
131# ".." element or be rooted.
132#
133rule reverse ( path )
134{
135    if $(path) = .
136    {
137        return $(path) ;
138    }
139    else
140    {
141        local tokens = [ regex.split $(path) / ] ;
142        local tokens2 ;
143        for local i in $(tokens)
144        {
145            tokens2 += .. ;
146        }
147        return [ sequence.join $(tokens2) : / ] ;
148    }
149}
150
151
152# Concatenates the passed path elements. Generates an error if any element other
153# than the first one is rooted. Skips any empty or undefined path elements.
154#
155rule join ( elements + )
156{
157    if ! $(elements[2-])
158    {
159        return $(elements[1]) ;
160    }
161    else
162    {
163        for local e in $(elements[2-])
164        {
165            if [ is-rooted $(e) ]
166            {
167                import errors ;
168                errors.error only the first element may be rooted ;
169            }
170        }
171        return [ NORMALIZE_PATH "$(elements)" ] ;
172    }
173}
174
175
176# If 'path' is relative, it is rooted at 'root'. Otherwise, it is unchanged.
177#
178rule root ( path root )
179{
180    if [ is-rooted $(path) ]
181    {
182        return $(path) ;
183    }
184    else
185    {
186        return [ join $(root) $(path) ] ;
187    }
188}
189
190
191# Returns the current working directory.
192#
193rule pwd ( )
194{
195    if ! $(.pwd)
196    {
197        .pwd = [ make [ PWD ] ] ;
198    }
199    return $(.pwd) ;
200}
201
202
203# Returns the list of files matching the given pattern in the specified
204# directory. Both directories and patterns are supplied as portable paths. Each
205# pattern should be non-absolute path, and can't contain "." or ".." elements.
206# Each slash separated element of pattern can contain the following special
207# characters:
208#   - '?', which match any character
209#   - '*', which matches arbitrary number of characters.
210# A file $(d)/e1/e2/e3 (where 'd' is in $(dirs)) matches pattern p1/p2/p3 if and
211# only if e1 matches p1, e2 matches p2 and so on.
212#
213# For example:
214#   [ glob . : *.cpp ]
215#   [ glob . : */build/Jamfile ]
216#
217rule glob ( dirs * : patterns + : exclude-patterns * )
218{
219    local result ;
220    local real-patterns ;
221    local real-exclude-patterns ;
222    for local d in $(dirs)
223    {
224        for local p in $(patterns)
225        {
226            local pattern = [ path.root $(p) $(d) ] ;
227            real-patterns += [ path.native $(pattern) ] ;
228        }
229
230        for local p in $(exclude-patterns)
231        {
232            local pattern = [ path.root $(p) $(d) ] ;
233            real-exclude-patterns += [ path.native $(pattern) ] ;
234        }
235    }
236
237    local inc = [ GLOB-RECURSIVELY $(real-patterns) ] ;
238    inc = [ sequence.transform NORMALIZE_PATH : $(inc) ] ;
239    local exc = [ GLOB-RECURSIVELY $(real-exclude-patterns) ] ;
240    exc = [ sequence.transform NORMALIZE_PATH : $(exc) ] ;
241
242    return [ sequence.transform path.make : [ set.difference $(inc) : $(exc) ] ]
243        ;
244}
245
246
247# Recursive version of GLOB. Builds the glob of files while also searching in
248# the subdirectories of the given roots. An optional set of exclusion patterns
249# will filter out the matching entries from the result. The exclusions also
250# apply to the subdirectory scanning, such that directories that match the
251# exclusion patterns will not be searched.
252#
253rule glob-tree ( roots * : patterns + : exclude-patterns * )
254{
255    return [ sequence.transform path.make : [ .glob-tree [ sequence.transform
256        path.native : $(roots) ] : $(patterns) : $(exclude-patterns) ] ] ;
257}
258
259
260local rule .glob-tree ( roots * : patterns * : exclude-patterns * )
261{
262    local excluded ;
263    if $(exclude-patterns)
264    {
265        excluded = [ GLOB $(roots) : $(exclude-patterns) ] ;
266    }
267    local result = [ set.difference [ GLOB $(roots) : $(patterns) ] :
268        $(excluded) ] ;
269    local subdirs ;
270    for local d in [ set.difference [ GLOB $(roots) : * ] : $(excluded) ]
271    {
272        if ! ( $(d:D=) in . .. ) && ! [ CHECK_IF_FILE $(d) ]
273        {
274            subdirs += $(d) ;
275        }
276    }
277    if $(subdirs)
278    {
279        result += [ .glob-tree $(subdirs) : $(patterns) : $(exclude-patterns) ]
280            ;
281    }
282    return $(result) ;
283}
284
285
286# Returns true is the specified file exists.
287#
288rule exists ( file )
289{
290    return [ path.glob $(file:D) : $(file:D=) ] ;
291}
292NATIVE_RULE path : exists ;
293
294
295# Find out the absolute name of path and returns the list of all the parents,
296# starting with the immediate one. Parents are returned as relative names. If
297# 'upper_limit' is specified, directories above it will be pruned.
298#
299rule all-parents ( path : upper_limit ? : cwd ? )
300{
301    cwd ?= [ pwd ] ;
302    local path_ele = [ regex.split [ root $(path) $(cwd) ] / ] ;
303
304    if ! $(upper_limit)
305    {
306        upper_limit = / ;
307    }
308    local upper_ele = [ regex.split [ root $(upper_limit) $(cwd) ] / ] ;
309
310    # Leave only elements in 'path_ele' below 'upper_ele'.
311    while $(path_ele) && ( $(upper_ele[1]) = $(path_ele[1]) )
312    {
313        upper_ele = $(upper_ele[2-]) ;
314        path_ele = $(path_ele[2-]) ;
315    }
316
317    # Have all upper elements been removed ?
318    if $(upper_ele)
319    {
320        import errors ;
321        errors.error "$(upper_limit) is not prefix of $(path)" ;
322    }
323
324    # Create the relative paths to parents, number of elements in 'path_ele'.
325    local result ;
326    for local i in $(path_ele)
327    {
328        path = [ parent $(path) ] ;
329        result += $(path) ;
330    }
331    return $(result) ;
332}
333
334
335# Search for 'pattern' in parent directories of 'dir', up to and including
336# 'upper_limit', if it is specified, or up to the filesystem root otherwise.
337#
338rule glob-in-parents ( dir : patterns + : upper-limit ? )
339{
340    local result ;
341    local parent-dirs = [ all-parents $(dir) : $(upper-limit) ] ;
342
343    while $(parent-dirs) && ! $(result)
344    {
345        result = [ glob $(parent-dirs[1]) : $(patterns) ] ;
346        parent-dirs = $(parent-dirs[2-]) ;
347    }
348    return $(result) ;
349}
350
351
352# Assuming 'child' is a subdirectory of 'parent', return the relative path from
353# 'parent' to 'child'.
354#
355rule relative ( child parent : no-error ? )
356{
357    local not-a-child ;
358    if $(parent) = "."
359    {
360        return $(child) ;
361    }
362    else
363    {
364        local split1 = [ regex.split $(parent) / ] ;
365        local split2 = [ regex.split $(child) / ] ;
366
367        while $(split1)
368        {
369            if $(split1[1]) = $(split2[1])
370            {
371                split1 = $(split1[2-]) ;
372                split2 = $(split2[2-]) ;
373            }
374            else
375            {
376                not-a-child = true ;
377                split1 = ;
378            }
379        }
380        if $(split2)
381        {
382            if $(not-a-child)
383            {
384                if $(no-error)
385                {
386                    return not-a-child ;
387                }
388                else
389                {
390                    import errors ;
391                    errors.error $(child) is not a subdir of $(parent) ;
392                }
393            }
394            else
395            {
396                return [ join $(split2) ] ;
397            }
398        }
399        else
400        {
401            return "." ;
402        }
403    }
404}
405
406
407# Returns the minimal path to path2 that is relative to path1.
408# If no such path exists and path2 is rooted, return it unchanged.
409#
410rule relative-to ( path1 path2 )
411{
412    local root_1 = [ regex.split [ reverse $(path1) ] / ] ;
413    local split1 = [ regex.split $(path1) / ] ;
414    local split2 = [ regex.split $(path2) / ] ;
415    local is-rooted ;
416
417    if $(split1[1]) = "" && $(split2[1]) = ""
418    {
419        is-rooted = true ;
420    }
421    else if $(split1[1]) != "" && $(split2[1]) = ""
422    {
423        # Second path is rooted
424        return $(path2) ;
425    }
426    else if $(split1[1]) = "" && $(split2[1]) != ""
427    {
428        import errors ;
429        errors.error Cannot find relative path from $(path1) to $(path2) ;
430    }
431
432    # For windows paths on different drives, return an
433    # absolute path
434    if $(os) = NT && $(split1[1]) = "" &&
435        [ MATCH "^(.:)$" : $(split1[2]) ] &&
436        $(split1[2]) != $(split2[2])
437    {
438        return $(path2) ;
439    }
440
441    while $(split1) && $(root_1)
442    {
443        if $(split1[1]) = $(split2[1])
444        {
445            root_1 = $(root_1[2-]) ;
446            split1 = $(split1[2-]) ;
447            split2 = $(split2[2-]) ;
448        }
449        else if $(split1[1]) = ..
450        {
451            if $(is-rooted)
452            {
453                return $(path2) ;
454            }
455            else
456            {
457                import errors ;
458                errors.error Cannot find relative path from $(path1) to $(path2) ;
459                return ;
460            }
461        }
462        else
463        {
464            split1 = ;
465        }
466    }
467    return [ join . $(root_1) $(split2) ] ;
468}
469
470
471# Returns the list of paths used by the operating system for looking up
472# programs.
473#
474rule programs-path ( )
475{
476    local result ;
477    local raw = [ modules.peek : PATH Path path ] ;
478    for local p in $(raw)
479    {
480        if $(p)
481        {
482            result += [ path.make $(p) ] ;
483        }
484    }
485    return $(result) ;
486}
487
488
489rule makedirs ( path )
490{
491    local result = true ;
492    local native = [ native $(path) ] ;
493    if ! [ exists $(native) ]
494    {
495        if [ makedirs [ parent $(path) ] ]
496        {
497            if ! [ MAKEDIR $(native) ]
498            {
499                import errors ;
500                errors.error "Could not create directory '$(path)'" ;
501                result = ;
502            }
503        }
504    }
505    return $(result) ;
506}
507
508
509# Converts native Windows paths into our internal canonic path representation.
510# Supports 'invalid' paths containing multiple successive path separator
511# characters.
512#
513# TODO: Check and if needed add support for Windows 'X:file' path format where
514# the file is located in the current folder on drive X.
515#
516rule make-NT ( native )
517{
518    local result = [ NORMALIZE_PATH $(native) ] ;
519
520    # We need to add an extra '/' in front in case this is a rooted Windows path
521    # starting with a drive letter and not a path separator character since the
522    # builtin NORMALIZE_PATH rule has no knowledge of this leading drive letter
523    # and treats it as a regular folder name.
524    if [ regex.match "(^.:)" : $(native) ]
525    {
526        result = /$(result) ;
527    }
528
529    return $(result) ;
530}
531
532
533rule native-NT ( path )
534{
535    local remove-slash = [ MATCH "^/(.:.*)" : $(path) ] ;
536    if $(remove-slash)
537    {
538        path = $(remove-slash) ;
539    }
540    return [ regex.replace $(path) / \\ ] ;
541}
542
543
544rule make-UNIX ( native )
545{
546    # VP: I have no idea now 'native' can be empty here! But it can!
547    if ! $(native)
548    {
549        import errors ;
550        errors.error "Empty path passed to 'make-UNIX'" ;
551    }
552    else
553    {
554        return [ NORMALIZE_PATH $(native:T) ] ;
555    }
556}
557
558
559rule native-UNIX ( path )
560{
561    return $(path) ;
562}
563
564
565rule make-CYGWIN ( path )
566{
567    return [ make-NT $(path) ] ;
568}
569
570
571rule native-CYGWIN ( path )
572{
573    local result = $(path) ;
574    if [ regex.match "(^/.:)" : $(path)  ]  # Windows absolute path.
575    {
576        result = [ MATCH "^/?(.*)" : $(path) ] ;  # Remove leading '/'.
577    }
578    return [ native-UNIX $(result) ] ;
579}
580
581
582# split-path-VMS: splits input native path into device dir file (each part is
583# optional).
584#
585# example:
586#
587# dev:[dir]file.c => dev: [dir] file.c
588#
589rule split-path-VMS ( native )
590{
591    local matches = [ MATCH "([a-zA-Z0-9_-]+:)?(\\[[^\]]*\\])?(.*)?$" : $(native)
592        ] ;
593    local device = $(matches[1]) ;
594    local dir = $(matches[2]) ;
595    local file = $(matches[3]) ;
596
597    return $(device) $(dir) $(file) ;
598}
599
600
601# Converts a native VMS path into a portable path spec.
602#
603# Does not handle current-device absolute paths such as "[dir]File.c" as it is
604# not clear how to represent them in the portable path notation.
605#
606# Adds a trailing dot (".") to the file part if no extension is present (helps
607# when converting it back into native path).
608#
609rule make-VMS ( native )
610{
611    ## Use POSIX-style path (keep previous code commented out - real magic!).
612    ## VMS CRTL supports POSIX path, JAM is retrofitted to pass it to VMS CRTL.
613
614    local portable = [ make-UNIX $(native) ] ;
615
616    #if [ MATCH ^(\\[[a-zA-Z0-9]) : $(native) ]
617    #{
618    #    import errors ;
619    #    errors.error "Can't handle default-device absolute paths: " $(native) ;
620    #}
621    #
622    #local parts = [ split-path-VMS $(native) ] ;
623    #local device = $(parts[1]) ;
624    #local dir = $(parts[2]) ;
625    #local file = $(parts[3]) ;
626    #local elems ;
627    #
628    #if $(device)
629    #{
630    #    #
631    #    # rooted
632    #    #
633    #    elems = /$(device) ;
634    #}
635    #
636    #if $(dir) = "[]"
637    #{
638    #    #
639    #    # Special case: current directory
640    #    #
641    #    elems = $(elems) "." ;
642    #}
643    #else if $(dir)
644    #{
645    #    dir = [ regex.replace $(dir) "\\[|\\]" "" ] ;
646    #    local dir_parts = [ regex.split $(dir) \\. ]  ;
647    #
648    #    if $(dir_parts[1]) = ""
649    #    {
650    #        #
651    #        # Relative path
652    #        #
653    #        dir_parts = $(dir_parts[2--1]) ;
654    #    }
655    #
656    #    #
657    #    # replace "parent-directory" parts (- => ..)
658    #    #
659    #    dir_parts = [ regex.replace-list $(dir_parts) : - : .. ] ;
660    #
661    #    elems = $(elems) $(dir_parts) ;
662    #}
663    #
664    #if $(file)
665    #{
666    #    if ! [ MATCH (\\.) : $(file) ]
667    #    {
668    #        #
669    #        # Always add "." to end of non-extension file.
670    #        #
671    #        file = $(file). ;
672    #    }
673    #    elems = $(elems) $(file) ;
674    #}
675    #
676    #portable = [ path.join $(elems) ] ;
677
678    return $(portable) ;
679}
680
681
682# Converts a portable path spec into a native VMS path.
683#
684# Relies on having at least one dot (".") included in the file name to be able
685# to differentiate it from the directory part.
686#
687rule native-VMS ( path )
688{
689    ## Use POSIX-style path (keep previous code commented out - real magic!).
690    ## VMS CRTL supports POSIX path, JAM is retrofitted to pass it to VMS CRTL.
691    ## NOTE: While translation to VMS-style is implemented with $(:W) modifier,
692    ##       Here we retain POSIX-style path, so it can be portably manipulated
693    ##       in B2 rules, and only in actions it's translated with $(:W).
694
695    local native = [ native-UNIX $(path) ] ;
696
697    #local device = "" ;
698    #local dir = $(path) ;
699    #local file = "" ;
700    #local split ;
701    #
702    ##
703    ## Has device ?
704    ##
705    #if [ is-rooted $(dir) ]
706    #{
707    #    split = [ MATCH ^/([^:]+:)/?(.*) : $(dir) ] ;
708    #    device = $(split[1]) ;
709    #    dir = $(split[2]) ;
710    #}
711    #
712    ##
713    ## Has file ?
714    ##
715    ## This is no exact science, just guess work:
716    ##
717    ## If the last part of the current path spec includes some chars, followed by
718    ## a dot, optionally followed by more chars - then it is a file (keep your
719    ## fingers crossed).
720    ##
721    #split = [ regex.split $(dir) / ] ;
722    #local maybe_file = $(split[-1]) ;
723    #
724    #if [ MATCH ^([^.]+\\..*) : $(maybe_file) ]
725    #{
726    #    file = $(maybe_file) ;
727    #    dir = [ sequence.join $(split[1--2]) : / ] ;
728    #}
729    #
730    ##
731    ## Has dir spec ?
732    ##
733    #if $(dir) = "."
734    #{
735    #    dir = "[]" ;
736    #}
737    #else if $(dir)
738    #{
739    #    dir = [ regex.replace $(dir) \\.\\. - ] ;
740    #    dir = [ regex.replace $(dir) / . ] ;
741    #
742    #    if $(device) = ""
743    #    {
744    #        #
745    #        # Relative directory
746    #        #
747    #        dir = "."$(dir) ;
748    #    }
749    #    dir = "["$(dir)"]" ;
750    #}
751    #
752    #native = [ sequence.join $(device) $(dir) $(file) ] ;
753
754    return $(native) ;
755}
756
757
758if $(os) = VMS
759{
760    # Translates POSIX-style path to VMS-style path
761    #
762    # This results in actual VMS path, unlike 'native-VMS' rule which is meant
763    # to return POSIX-style in order to mask VMS specificity and help portability.
764
765    rule to-VMS ( path )
766    {
767        return $(path:W) ;
768    }
769
770    EXPORT $(__name__) : to-$(os) ;
771}
772
773# Remove one level of indirection
774IMPORT $(__name__) : make-$(os) native-$(os) : $(__name__) : make native ;
775EXPORT $(__name__) : make native ;
776
777rule __test__ ( )
778{
779    import assert ;
780    import errors : try catch ;
781
782    assert.true is-rooted "/" ;
783    assert.true is-rooted "/foo" ;
784    assert.true is-rooted "/foo/bar" ;
785    assert.result : is-rooted "." ;
786    assert.result : is-rooted "foo" ;
787    assert.result : is-rooted "foo/bar" ;
788
789    assert.true has-parent "foo" ;
790    assert.true has-parent "foo/bar" ;
791    assert.true has-parent "." ;
792    assert.result : has-parent "/" ;
793
794    assert.result "." : basename "." ;
795    assert.result ".." : basename ".." ;
796    assert.result "foo" : basename "foo" ;
797    assert.result "foo" : basename "bar/foo" ;
798    assert.result "foo" : basename "gaz/bar/foo" ;
799    assert.result "foo" : basename "/gaz/bar/foo" ;
800
801    assert.result "." : parent "foo" ;
802    assert.result "/" : parent "/foo" ;
803    assert.result "foo/bar" : parent "foo/bar/giz" ;
804    assert.result ".." : parent "." ;
805    assert.result ".." : parent "../foo" ;
806    assert.result "../../foo" : parent "../../foo/bar" ;
807
808    assert.result "." : reverse "." ;
809    assert.result ".." : reverse "foo" ;
810    assert.result "../../.." : reverse "foo/bar/giz" ;
811
812    assert.result "foo" : join "foo" ;
813    assert.result "/foo" : join "/" "foo" ;
814    assert.result "foo/bar" : join "foo" "bar" ;
815    assert.result "foo/bar" : join "foo/giz" "../bar" ;
816    assert.result "foo/giz" : join "foo/bar/baz" "../../giz" ;
817    assert.result ".." : join "." ".." ;
818    assert.result ".." : join "foo" "../.." ;
819    assert.result "../.." : join "../foo" "../.." ;
820    assert.result "/foo" : join "/bar" "../foo" ;
821    assert.result "foo/giz" : join "foo/giz" "." ;
822    assert.result "." : join lib2 ".." ;
823    assert.result "/" : join "/a" ".." ;
824
825    assert.result /a/b : join /a/b/c .. ;
826
827    assert.result "foo/bar/giz" : join "foo" "bar" "giz" ;
828    assert.result "giz" : join "foo" ".." "giz" ;
829    assert.result "foo/giz" : join "foo" "." "giz" ;
830
831    try ;
832    {
833        join "a" "/b" ;
834    }
835    catch only first element may be rooted ;
836
837    local CWD = "/home/ghost/build" ;
838    assert.result : all-parents . : . : $(CWD) ;
839    assert.result . .. ../.. ../../..  : all-parents "Jamfile" : "" : $(CWD) ;
840    assert.result foo . .. ../.. ../../.. : all-parents "foo/Jamfile" : "" :
841        $(CWD) ;
842    assert.result ../Work .. ../.. ../../.. : all-parents "../Work/Jamfile" : ""
843        : $(CWD) ;
844
845    local CWD = "/home/ghost" ;
846    assert.result . .. : all-parents "Jamfile" : "/home" : $(CWD) ;
847    assert.result . : all-parents "Jamfile" : "/home/ghost" : $(CWD) ;
848
849    assert.result "c/d" : relative "a/b/c/d" "a/b" ;
850    assert.result "foo" : relative "foo" "." ;
851
852    assert.result "c/d" : relative-to "a/b" "a/b/c/d" ;
853    assert.result "foo" : relative-to "." "foo" ;
854    assert.result "../d" : relative-to "/a/b" "/a/d" ;
855    assert.result "x" : relative-to .. ../x ;
856    assert.result "/x" : relative-to x /x ;
857    try ;
858    {
859        relative-to "../x" "a" ;
860    }
861    catch Cannot find relative path from ../x to a ;
862    try ;
863    {
864        relative-to "../../x" "../a" ;
865    }
866    catch Cannot find relative path from ../../x to ../a ;
867    try ;
868    {
869        relative-to "/x/y" "a/b" ;
870    }
871    catch Cannot find relative path from /x/y to a/b ;
872
873    local save-os = [ modules.peek path : os ] ;
874    modules.poke path : os : NT ;
875
876    assert.result "foo/bar/giz" : make-NT "foo/bar/giz" ;
877    assert.result "foo/bar/giz" : make-NT "foo\\bar\\giz" ;
878    assert.result "foo" : make-NT "foo/" ;
879    assert.result "foo" : make-NT "foo\\" ;
880    assert.result "foo" : make-NT "foo/." ;
881    assert.result "foo" : make-NT "foo/bar/.." ;
882    assert.result "foo" : make-NT "foo/bar/../" ;
883    assert.result "foo" : make-NT "foo/bar/..\\" ;
884    assert.result "foo/bar" : make-NT "foo/././././bar" ;
885    assert.result "/foo" : make-NT "\\foo" ;
886    assert.result "/D:/My Documents" : make-NT "D:\\My Documents" ;
887    assert.result "/c:/boost/tools/build/new/project.jam" : make-NT
888        "c:\\boost\\tools\\build\\test\\..\\new\\project.jam" ;
889
890    # Test processing 'invalid' paths containing multiple successive path
891    # separators.
892    assert.result "foo" : make-NT "foo//" ;
893    assert.result "foo" : make-NT "foo///" ;
894    assert.result "foo" : make-NT "foo\\\\" ;
895    assert.result "foo" : make-NT "foo\\\\\\" ;
896    assert.result "/foo" : make-NT "//foo" ;
897    assert.result "/foo" : make-NT "///foo" ;
898    assert.result "/foo" : make-NT "\\\\foo" ;
899    assert.result "/foo" : make-NT "\\\\\\foo" ;
900    assert.result "/foo" : make-NT "\\/\\/foo" ;
901    assert.result "foo/bar" : make-NT "foo//\\//\\\\bar//\\//\\\\\\//\\//\\\\" ;
902    assert.result "foo" : make-NT "foo/bar//.." ;
903    assert.result "foo/bar" : make-NT "foo/bar/giz//.." ;
904    assert.result "foo/giz" : make-NT
905        "foo//\\//\\\\bar///\\\\//\\\\////\\/..///giz\\//\\\\\\//\\//\\\\" ;
906    assert.result "../../../foo" : make-NT "..///.//..///.//..////foo///" ;
907
908    # Test processing 'invalid' rooted paths with too many '..' path elements
909    # that would place them before the root.
910    assert.result : make-NT "/.." ;
911    assert.result : make-NT "/../" ;
912    assert.result : make-NT "/../." ;
913    assert.result : make-NT "/.././" ;
914    assert.result : make-NT "/foo/../bar/giz/.././././../../." ;
915    assert.result : make-NT "/foo/../bar/giz/.././././../.././" ;
916    assert.result : make-NT "//foo/../bar/giz/.././././../../." ;
917    assert.result : make-NT "//foo/../bar/giz/.././././../.././" ;
918    assert.result : make-NT "\\\\foo/../bar/giz/.././././../../." ;
919    assert.result : make-NT "\\\\foo/../bar/giz/.././././../.././" ;
920    assert.result : make-NT "/..///.//..///.//..////foo///" ;
921
922    assert.result "foo\\bar\\giz" : native-NT "foo/bar/giz" ;
923    assert.result "foo" : native-NT "foo" ;
924    assert.result "\\foo" : native-NT "/foo" ;
925    assert.result "D:\\My Documents\\Work" : native-NT "/D:/My Documents/Work" ;
926
927    assert.result "../y" : relative-to "/C:/x" "/C:/y" ;
928    assert.result "/D:/test" : relative-to "/C:/test" "/D:/test" ;
929    try ;
930    {
931        relative-to "/C:/y" "a/b" ;
932    }
933    catch Cannot find relative path from "/C:/y" to a/b ;
934
935    modules.poke path : os : UNIX ;
936
937    assert.result "foo/bar/giz" : make-UNIX "foo/bar/giz" ;
938    assert.result "/sub1" : make-UNIX "/sub1/." ;
939    assert.result "/sub1" : make-UNIX "/sub1/sub2/.." ;
940    assert.result "sub1" : make-UNIX "sub1/." ;
941    assert.result "sub1" : make-UNIX "sub1/sub2/.." ;
942    assert.result "/foo/bar" : native-UNIX "/foo/bar" ;
943
944    modules.poke path : os : VMS ;
945
946    ## On VMS use POSIX-style path (keep previous tests commented out).
947
948    assert.result "foo/bar/giz" : make-VMS "foo/bar/giz" ;
949    assert.result "/sub1" : make-VMS "/sub1/." ;
950    assert.result "/sub1" : make-VMS "/sub1/sub2/.." ;
951    assert.result "sub1" : make-VMS "sub1/." ;
952    assert.result "sub1" : make-VMS "sub1/sub2/.." ;
953    assert.result "/foo/bar" : native-VMS "/foo/bar" ;
954
955    ##
956    ## Do not really need to poke os before these
957    ##
958    #assert.result "disk:" "[dir]"  "file" : split-path-VMS "disk:[dir]file" ;
959    #assert.result "disk:" "[dir]"  ""     : split-path-VMS "disk:[dir]" ;
960    #assert.result "disk:" ""       ""     : split-path-VMS "disk:" ;
961    #assert.result "disk:" ""       "file" : split-path-VMS "disk:file" ;
962    #assert.result ""      "[dir]"  "file" : split-path-VMS "[dir]file" ;
963    #assert.result ""      "[dir]"  ""     : split-path-VMS "[dir]" ;
964    #assert.result ""      ""       "file" : split-path-VMS "file" ;
965    #assert.result ""      ""       ""     : split-path-VMS "" ;
966    #
967    ##
968    ## Special case: current directory
969    ##
970    #assert.result ""      "[]"     ""     : split-path-VMS "[]" ;
971    #assert.result "disk:" "[]"     ""     : split-path-VMS "disk:[]" ;
972    #assert.result ""      "[]"     "file" : split-path-VMS "[]file" ;
973    #assert.result "disk:" "[]"     "file" : split-path-VMS "disk:[]file" ;
974    #
975    ##
976    ## Make portable paths
977    ##
978    #assert.result "/disk:" : make-VMS "disk:" ;
979    #assert.result "foo/bar/giz" : make-VMS "[.foo.bar.giz]" ;
980    #assert.result "foo" : make-VMS "[.foo]" ;
981    #assert.result "foo" : make-VMS "[.foo.bar.-]" ;
982    #assert.result ".." : make-VMS "[.-]" ;
983    #assert.result ".." : make-VMS "[-]" ;
984    #assert.result "." : make-VMS "[]" ;
985    #assert.result "giz.h" : make-VMS "giz.h" ;
986    #assert.result "foo/bar/giz.h" : make-VMS "[.foo.bar]giz.h" ;
987    #assert.result "/disk:/my_docs" : make-VMS "disk:[my_docs]" ;
988    #assert.result "/disk:/boost/tools/build/new/project.jam" : make-VMS
989    #    "disk:[boost.tools.build.test.-.new]project.jam" ;
990    #
991    ##
992    ## Special case (adds '.' to end of file w/o extension to disambiguate from
993    ## directory in portable path spec)
994    ##
995    #assert.result "Jamfile." : make-VMS "Jamfile" ;
996    #assert.result "dir/Jamfile." : make-VMS "[.dir]Jamfile" ;
997    #assert.result "/disk:/dir/Jamfile." : make-VMS "disk:[dir]Jamfile" ;
998    #
999    ##
1000    ## Make native paths
1001    ##
1002    #assert.result "disk:" : native-VMS "/disk:" ;
1003    #assert.result "[.foo.bar.giz]" : native-VMS "foo/bar/giz" ;
1004    #assert.result "[.foo]" : native-VMS "foo" ;
1005    #assert.result "[.-]" : native-VMS ".." ;
1006    #assert.result "[.foo.-]" : native-VMS "foo/.." ;
1007    #assert.result "[]" : native-VMS "." ;
1008    #assert.result "disk:[my_docs.work]" : native-VMS "/disk:/my_docs/work" ;
1009    #assert.result "giz.h" : native-VMS "giz.h" ;
1010    #assert.result "disk:Jamfile." : native-VMS "/disk:Jamfile." ;
1011    #assert.result "disk:[my_docs.work]Jamfile." : native-VMS
1012    #    "/disk:/my_docs/work/Jamfile." ;
1013
1014    modules.poke path : os : $(save-os) ;
1015}
1016