]>
Commit | Line | Data |
---|---|---|
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 | ||
19 | import modules ; | |
20 | import regex ; | |
21 | import sequence ; | |
22 | import set ; | |
23 | ||
24 | ||
25 | os = [ modules.peek : OS ] ; | |
26 | if [ 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 | # | |
39 | rule make ( native ) | |
40 | { | |
41 | return [ make-$(os) $(native) ] ; | |
42 | } | |
43 | ||
44 | ||
45 | # Builds native representation of the path. | |
46 | # | |
47 | rule native ( path ) | |
48 | { | |
49 | return [ native-$(os) $(path) ] ; | |
50 | } | |
51 | ||
52 | ||
53 | # Tests if a path is rooted. | |
54 | # | |
55 | rule is-rooted ( path ) | |
56 | { | |
57 | return [ MATCH "^(/)" : $(path) ] ; | |
58 | } | |
59 | ||
60 | ||
61 | # Tests if a path has a parent. | |
62 | # | |
63 | rule 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 | # | |
78 | rule 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 | # | |
86 | rule 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 | # | |
133 | rule 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 | # | |
155 | rule 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 | # | |
178 | rule 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 | # | |
193 | rule 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 | # | |
217 | rule 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 | # | |
253 | rule 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 | ||
260 | local 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 | # | |
288 | rule exists ( file ) | |
289 | { | |
290 | return [ path.glob $(file:D) : $(file:D=) ] ; | |
291 | } | |
292 | NATIVE_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 | # | |
299 | rule 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 | # | |
338 | rule 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 | # | |
355 | rule 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 | # |
410 | rule 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 | # | |
474 | rule 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 | ||
489 | rule 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 | # | |
516 | rule 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 | ||
533 | rule 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 | ||
544 | rule 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 | ||
559 | rule native-UNIX ( path ) | |
560 | { | |
561 | return $(path) ; | |
562 | } | |
563 | ||
564 | ||
565 | rule make-CYGWIN ( path ) | |
566 | { | |
567 | return [ make-NT $(path) ] ; | |
568 | } | |
569 | ||
570 | ||
571 | rule 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 | # | |
589 | rule 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 | # | |
609 | rule 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 | # | |
687 | rule 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 | ||
758 | if $(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 | |
774 | IMPORT $(__name__) : make-$(os) native-$(os) : $(__name__) : make native ; | |
775 | EXPORT $(__name__) : make native ; | |
776 | ||
777 | rule __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 | } |