]> git.proxmox.com Git - ceph.git/blame - ceph/src/boost/tools/build/src/util/path.jam
update ceph source to reef 18.1.2
[ceph.git] / ceph / src / boost / tools / build / src / util / path.jam
CommitLineData
7c673cae
FG
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.
1e59de90
TL
5# (See accompanying file LICENSE.txt or copy at
6# https://www.bfgroup.xyz/b2/LICENSE.txt)
7c673cae
FG
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.
92f5a8d4 408# If no such path exists and path2 is rooted, return it unchanged.
7c673cae
FG
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) / ] ;
92f5a8d4
TL
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 }
7c673cae
FG
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 }
92f5a8d4
TL
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 }
7c673cae
FG
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{
11fdf7f2 591 local matches = [ MATCH "([a-zA-Z0-9_-]+:)?(\\[[^\]]*\\])?(.*)?$" : $(native)
7c673cae
FG
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
92f5a8d4
TL
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
7c673cae
FG
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
92f5a8d4
TL
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
7c673cae
FG
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}