]>
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. | |
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 | ||
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. | |
408 | # | |
409 | rule relative-to ( path1 path2 ) | |
410 | { | |
411 | local root_1 = [ regex.split [ reverse $(path1) ] / ] ; | |
412 | local split1 = [ regex.split $(path1) / ] ; | |
413 | local split2 = [ regex.split $(path2) / ] ; | |
414 | ||
415 | while $(split1) && $(root_1) | |
416 | { | |
417 | if $(split1[1]) = $(split2[1]) | |
418 | { | |
419 | root_1 = $(root_1[2-]) ; | |
420 | split1 = $(split1[2-]) ; | |
421 | split2 = $(split2[2-]) ; | |
422 | } | |
423 | else | |
424 | { | |
425 | split1 = ; | |
426 | } | |
427 | } | |
428 | return [ join . $(root_1) $(split2) ] ; | |
429 | } | |
430 | ||
431 | ||
432 | # Returns the list of paths used by the operating system for looking up | |
433 | # programs. | |
434 | # | |
435 | rule programs-path ( ) | |
436 | { | |
437 | local result ; | |
438 | local raw = [ modules.peek : PATH Path path ] ; | |
439 | for local p in $(raw) | |
440 | { | |
441 | if $(p) | |
442 | { | |
443 | result += [ path.make $(p) ] ; | |
444 | } | |
445 | } | |
446 | return $(result) ; | |
447 | } | |
448 | ||
449 | ||
450 | rule makedirs ( path ) | |
451 | { | |
452 | local result = true ; | |
453 | local native = [ native $(path) ] ; | |
454 | if ! [ exists $(native) ] | |
455 | { | |
456 | if [ makedirs [ parent $(path) ] ] | |
457 | { | |
458 | if ! [ MAKEDIR $(native) ] | |
459 | { | |
460 | import errors ; | |
461 | errors.error "Could not create directory '$(path)'" ; | |
462 | result = ; | |
463 | } | |
464 | } | |
465 | } | |
466 | return $(result) ; | |
467 | } | |
468 | ||
469 | ||
470 | # Converts native Windows paths into our internal canonic path representation. | |
471 | # Supports 'invalid' paths containing multiple successive path separator | |
472 | # characters. | |
473 | # | |
474 | # TODO: Check and if needed add support for Windows 'X:file' path format where | |
475 | # the file is located in the current folder on drive X. | |
476 | # | |
477 | rule make-NT ( native ) | |
478 | { | |
479 | local result = [ NORMALIZE_PATH $(native) ] ; | |
480 | ||
481 | # We need to add an extra '/' in front in case this is a rooted Windows path | |
482 | # starting with a drive letter and not a path separator character since the | |
483 | # builtin NORMALIZE_PATH rule has no knowledge of this leading drive letter | |
484 | # and treats it as a regular folder name. | |
485 | if [ regex.match "(^.:)" : $(native) ] | |
486 | { | |
487 | result = /$(result) ; | |
488 | } | |
489 | ||
490 | return $(result) ; | |
491 | } | |
492 | ||
493 | ||
494 | rule native-NT ( path ) | |
495 | { | |
496 | local remove-slash = [ MATCH "^/(.:.*)" : $(path) ] ; | |
497 | if $(remove-slash) | |
498 | { | |
499 | path = $(remove-slash) ; | |
500 | } | |
501 | return [ regex.replace $(path) / \\ ] ; | |
502 | } | |
503 | ||
504 | ||
505 | rule make-UNIX ( native ) | |
506 | { | |
507 | # VP: I have no idea now 'native' can be empty here! But it can! | |
508 | if ! $(native) | |
509 | { | |
510 | import errors ; | |
511 | errors.error "Empty path passed to 'make-UNIX'" ; | |
512 | } | |
513 | else | |
514 | { | |
515 | return [ NORMALIZE_PATH $(native:T) ] ; | |
516 | } | |
517 | } | |
518 | ||
519 | ||
520 | rule native-UNIX ( path ) | |
521 | { | |
522 | return $(path) ; | |
523 | } | |
524 | ||
525 | ||
526 | rule make-CYGWIN ( path ) | |
527 | { | |
528 | return [ make-NT $(path) ] ; | |
529 | } | |
530 | ||
531 | ||
532 | rule native-CYGWIN ( path ) | |
533 | { | |
534 | local result = $(path) ; | |
535 | if [ regex.match "(^/.:)" : $(path) ] # Windows absolute path. | |
536 | { | |
537 | result = [ MATCH "^/?(.*)" : $(path) ] ; # Remove leading '/'. | |
538 | } | |
539 | return [ native-UNIX $(result) ] ; | |
540 | } | |
541 | ||
542 | ||
543 | # split-path-VMS: splits input native path into device dir file (each part is | |
544 | # optional). | |
545 | # | |
546 | # example: | |
547 | # | |
548 | # dev:[dir]file.c => dev: [dir] file.c | |
549 | # | |
550 | rule split-path-VMS ( native ) | |
551 | { | |
11fdf7f2 | 552 | local matches = [ MATCH "([a-zA-Z0-9_-]+:)?(\\[[^\]]*\\])?(.*)?$" : $(native) |
7c673cae FG |
553 | ] ; |
554 | local device = $(matches[1]) ; | |
555 | local dir = $(matches[2]) ; | |
556 | local file = $(matches[3]) ; | |
557 | ||
558 | return $(device) $(dir) $(file) ; | |
559 | } | |
560 | ||
561 | ||
562 | # Converts a native VMS path into a portable path spec. | |
563 | # | |
564 | # Does not handle current-device absolute paths such as "[dir]File.c" as it is | |
565 | # not clear how to represent them in the portable path notation. | |
566 | # | |
567 | # Adds a trailing dot (".") to the file part if no extension is present (helps | |
568 | # when converting it back into native path). | |
569 | # | |
570 | rule make-VMS ( native ) | |
571 | { | |
572 | ## Use POSIX-style path (keep previous code commented out - real magic!). | |
573 | ## VMS CRTL supports POSIX path, JAM is retrofitted to pass it to VMS CRTL. | |
574 | ||
575 | local portable = [ make-UNIX $(native) ] ; | |
576 | ||
577 | #if [ MATCH ^(\\[[a-zA-Z0-9]) : $(native) ] | |
578 | #{ | |
579 | # import errors ; | |
580 | # errors.error "Can't handle default-device absolute paths: " $(native) ; | |
581 | #} | |
582 | # | |
583 | #local parts = [ split-path-VMS $(native) ] ; | |
584 | #local device = $(parts[1]) ; | |
585 | #local dir = $(parts[2]) ; | |
586 | #local file = $(parts[3]) ; | |
587 | #local elems ; | |
588 | # | |
589 | #if $(device) | |
590 | #{ | |
591 | # # | |
592 | # # rooted | |
593 | # # | |
594 | # elems = /$(device) ; | |
595 | #} | |
596 | # | |
597 | #if $(dir) = "[]" | |
598 | #{ | |
599 | # # | |
600 | # # Special case: current directory | |
601 | # # | |
602 | # elems = $(elems) "." ; | |
603 | #} | |
604 | #else if $(dir) | |
605 | #{ | |
606 | # dir = [ regex.replace $(dir) "\\[|\\]" "" ] ; | |
607 | # local dir_parts = [ regex.split $(dir) \\. ] ; | |
608 | # | |
609 | # if $(dir_parts[1]) = "" | |
610 | # { | |
611 | # # | |
612 | # # Relative path | |
613 | # # | |
614 | # dir_parts = $(dir_parts[2--1]) ; | |
615 | # } | |
616 | # | |
617 | # # | |
618 | # # replace "parent-directory" parts (- => ..) | |
619 | # # | |
620 | # dir_parts = [ regex.replace-list $(dir_parts) : - : .. ] ; | |
621 | # | |
622 | # elems = $(elems) $(dir_parts) ; | |
623 | #} | |
624 | # | |
625 | #if $(file) | |
626 | #{ | |
627 | # if ! [ MATCH (\\.) : $(file) ] | |
628 | # { | |
629 | # # | |
630 | # # Always add "." to end of non-extension file. | |
631 | # # | |
632 | # file = $(file). ; | |
633 | # } | |
634 | # elems = $(elems) $(file) ; | |
635 | #} | |
636 | # | |
637 | #portable = [ path.join $(elems) ] ; | |
638 | ||
639 | return $(portable) ; | |
640 | } | |
641 | ||
642 | ||
643 | # Converts a portable path spec into a native VMS path. | |
644 | # | |
645 | # Relies on having at least one dot (".") included in the file name to be able | |
646 | # to differentiate it from the directory part. | |
647 | # | |
648 | rule native-VMS ( path ) | |
649 | { | |
650 | ## Use POSIX-style path (keep previous code commented out - real magic!). | |
651 | ## VMS CRTL supports POSIX path, JAM is retrofitted to pass it to VMS CRTL. | |
652 | ## NOTE: While translation to VMS-style is implemented with $(:W) modifier, | |
653 | ## Here we retain POSIX-style path, so it can be portably manipulated | |
654 | ## in B2 rules, and only in actions it's translated with $(:W). | |
655 | ||
656 | local native = [ native-UNIX $(path) ] ; | |
657 | ||
658 | #local device = "" ; | |
659 | #local dir = $(path) ; | |
660 | #local file = "" ; | |
661 | #local split ; | |
662 | # | |
663 | ## | |
664 | ## Has device ? | |
665 | ## | |
666 | #if [ is-rooted $(dir) ] | |
667 | #{ | |
668 | # split = [ MATCH ^/([^:]+:)/?(.*) : $(dir) ] ; | |
669 | # device = $(split[1]) ; | |
670 | # dir = $(split[2]) ; | |
671 | #} | |
672 | # | |
673 | ## | |
674 | ## Has file ? | |
675 | ## | |
676 | ## This is no exact science, just guess work: | |
677 | ## | |
678 | ## If the last part of the current path spec includes some chars, followed by | |
679 | ## a dot, optionally followed by more chars - then it is a file (keep your | |
680 | ## fingers crossed). | |
681 | ## | |
682 | #split = [ regex.split $(dir) / ] ; | |
683 | #local maybe_file = $(split[-1]) ; | |
684 | # | |
685 | #if [ MATCH ^([^.]+\\..*) : $(maybe_file) ] | |
686 | #{ | |
687 | # file = $(maybe_file) ; | |
688 | # dir = [ sequence.join $(split[1--2]) : / ] ; | |
689 | #} | |
690 | # | |
691 | ## | |
692 | ## Has dir spec ? | |
693 | ## | |
694 | #if $(dir) = "." | |
695 | #{ | |
696 | # dir = "[]" ; | |
697 | #} | |
698 | #else if $(dir) | |
699 | #{ | |
700 | # dir = [ regex.replace $(dir) \\.\\. - ] ; | |
701 | # dir = [ regex.replace $(dir) / . ] ; | |
702 | # | |
703 | # if $(device) = "" | |
704 | # { | |
705 | # # | |
706 | # # Relative directory | |
707 | # # | |
708 | # dir = "."$(dir) ; | |
709 | # } | |
710 | # dir = "["$(dir)"]" ; | |
711 | #} | |
712 | # | |
713 | #native = [ sequence.join $(device) $(dir) $(file) ] ; | |
714 | ||
715 | return $(native) ; | |
716 | } | |
717 | ||
718 | ||
719 | if $(os) = VMS | |
720 | { | |
721 | # Translates POSIX-style path to VMS-style path | |
722 | # | |
723 | # This results in actual VMS path, unlike 'native-VMS' rule which is meant | |
724 | # to return POSIX-style in order to mask VMS specificity and help portability. | |
725 | ||
726 | rule to-VMS ( path ) | |
727 | { | |
728 | return $(path:W) ; | |
729 | } | |
730 | ||
731 | EXPORT $(__name__) : to-$(os) ; | |
732 | } | |
733 | ||
734 | # Remove one level of indirection | |
735 | IMPORT $(__name__) : make-$(os) native-$(os) : $(__name__) : make native ; | |
736 | EXPORT $(__name__) : make native ; | |
737 | ||
738 | rule __test__ ( ) | |
739 | { | |
740 | import assert ; | |
741 | import errors : try catch ; | |
742 | ||
743 | assert.true is-rooted "/" ; | |
744 | assert.true is-rooted "/foo" ; | |
745 | assert.true is-rooted "/foo/bar" ; | |
746 | assert.result : is-rooted "." ; | |
747 | assert.result : is-rooted "foo" ; | |
748 | assert.result : is-rooted "foo/bar" ; | |
749 | ||
750 | assert.true has-parent "foo" ; | |
751 | assert.true has-parent "foo/bar" ; | |
752 | assert.true has-parent "." ; | |
753 | assert.result : has-parent "/" ; | |
754 | ||
755 | assert.result "." : basename "." ; | |
756 | assert.result ".." : basename ".." ; | |
757 | assert.result "foo" : basename "foo" ; | |
758 | assert.result "foo" : basename "bar/foo" ; | |
759 | assert.result "foo" : basename "gaz/bar/foo" ; | |
760 | assert.result "foo" : basename "/gaz/bar/foo" ; | |
761 | ||
762 | assert.result "." : parent "foo" ; | |
763 | assert.result "/" : parent "/foo" ; | |
764 | assert.result "foo/bar" : parent "foo/bar/giz" ; | |
765 | assert.result ".." : parent "." ; | |
766 | assert.result ".." : parent "../foo" ; | |
767 | assert.result "../../foo" : parent "../../foo/bar" ; | |
768 | ||
769 | assert.result "." : reverse "." ; | |
770 | assert.result ".." : reverse "foo" ; | |
771 | assert.result "../../.." : reverse "foo/bar/giz" ; | |
772 | ||
773 | assert.result "foo" : join "foo" ; | |
774 | assert.result "/foo" : join "/" "foo" ; | |
775 | assert.result "foo/bar" : join "foo" "bar" ; | |
776 | assert.result "foo/bar" : join "foo/giz" "../bar" ; | |
777 | assert.result "foo/giz" : join "foo/bar/baz" "../../giz" ; | |
778 | assert.result ".." : join "." ".." ; | |
779 | assert.result ".." : join "foo" "../.." ; | |
780 | assert.result "../.." : join "../foo" "../.." ; | |
781 | assert.result "/foo" : join "/bar" "../foo" ; | |
782 | assert.result "foo/giz" : join "foo/giz" "." ; | |
783 | assert.result "." : join lib2 ".." ; | |
784 | assert.result "/" : join "/a" ".." ; | |
785 | ||
786 | assert.result /a/b : join /a/b/c .. ; | |
787 | ||
788 | assert.result "foo/bar/giz" : join "foo" "bar" "giz" ; | |
789 | assert.result "giz" : join "foo" ".." "giz" ; | |
790 | assert.result "foo/giz" : join "foo" "." "giz" ; | |
791 | ||
792 | try ; | |
793 | { | |
794 | join "a" "/b" ; | |
795 | } | |
796 | catch only first element may be rooted ; | |
797 | ||
798 | local CWD = "/home/ghost/build" ; | |
799 | assert.result : all-parents . : . : $(CWD) ; | |
800 | assert.result . .. ../.. ../../.. : all-parents "Jamfile" : "" : $(CWD) ; | |
801 | assert.result foo . .. ../.. ../../.. : all-parents "foo/Jamfile" : "" : | |
802 | $(CWD) ; | |
803 | assert.result ../Work .. ../.. ../../.. : all-parents "../Work/Jamfile" : "" | |
804 | : $(CWD) ; | |
805 | ||
806 | local CWD = "/home/ghost" ; | |
807 | assert.result . .. : all-parents "Jamfile" : "/home" : $(CWD) ; | |
808 | assert.result . : all-parents "Jamfile" : "/home/ghost" : $(CWD) ; | |
809 | ||
810 | assert.result "c/d" : relative "a/b/c/d" "a/b" ; | |
811 | assert.result "foo" : relative "foo" "." ; | |
812 | ||
813 | local save-os = [ modules.peek path : os ] ; | |
814 | modules.poke path : os : NT ; | |
815 | ||
816 | assert.result "foo/bar/giz" : make-NT "foo/bar/giz" ; | |
817 | assert.result "foo/bar/giz" : make-NT "foo\\bar\\giz" ; | |
818 | assert.result "foo" : make-NT "foo/" ; | |
819 | assert.result "foo" : make-NT "foo\\" ; | |
820 | assert.result "foo" : make-NT "foo/." ; | |
821 | assert.result "foo" : make-NT "foo/bar/.." ; | |
822 | assert.result "foo" : make-NT "foo/bar/../" ; | |
823 | assert.result "foo" : make-NT "foo/bar/..\\" ; | |
824 | assert.result "foo/bar" : make-NT "foo/././././bar" ; | |
825 | assert.result "/foo" : make-NT "\\foo" ; | |
826 | assert.result "/D:/My Documents" : make-NT "D:\\My Documents" ; | |
827 | assert.result "/c:/boost/tools/build/new/project.jam" : make-NT | |
828 | "c:\\boost\\tools\\build\\test\\..\\new\\project.jam" ; | |
829 | ||
830 | # Test processing 'invalid' paths containing multiple successive path | |
831 | # separators. | |
832 | assert.result "foo" : make-NT "foo//" ; | |
833 | assert.result "foo" : make-NT "foo///" ; | |
834 | assert.result "foo" : make-NT "foo\\\\" ; | |
835 | assert.result "foo" : make-NT "foo\\\\\\" ; | |
836 | assert.result "/foo" : make-NT "//foo" ; | |
837 | assert.result "/foo" : make-NT "///foo" ; | |
838 | assert.result "/foo" : make-NT "\\\\foo" ; | |
839 | assert.result "/foo" : make-NT "\\\\\\foo" ; | |
840 | assert.result "/foo" : make-NT "\\/\\/foo" ; | |
841 | assert.result "foo/bar" : make-NT "foo//\\//\\\\bar//\\//\\\\\\//\\//\\\\" ; | |
842 | assert.result "foo" : make-NT "foo/bar//.." ; | |
843 | assert.result "foo/bar" : make-NT "foo/bar/giz//.." ; | |
844 | assert.result "foo/giz" : make-NT | |
845 | "foo//\\//\\\\bar///\\\\//\\\\////\\/..///giz\\//\\\\\\//\\//\\\\" ; | |
846 | assert.result "../../../foo" : make-NT "..///.//..///.//..////foo///" ; | |
847 | ||
848 | # Test processing 'invalid' rooted paths with too many '..' path elements | |
849 | # that would place them before the root. | |
850 | assert.result : make-NT "/.." ; | |
851 | assert.result : make-NT "/../" ; | |
852 | assert.result : make-NT "/../." ; | |
853 | assert.result : make-NT "/.././" ; | |
854 | assert.result : make-NT "/foo/../bar/giz/.././././../../." ; | |
855 | assert.result : make-NT "/foo/../bar/giz/.././././../.././" ; | |
856 | assert.result : make-NT "//foo/../bar/giz/.././././../../." ; | |
857 | assert.result : make-NT "//foo/../bar/giz/.././././../.././" ; | |
858 | assert.result : make-NT "\\\\foo/../bar/giz/.././././../../." ; | |
859 | assert.result : make-NT "\\\\foo/../bar/giz/.././././../.././" ; | |
860 | assert.result : make-NT "/..///.//..///.//..////foo///" ; | |
861 | ||
862 | assert.result "foo\\bar\\giz" : native-NT "foo/bar/giz" ; | |
863 | assert.result "foo" : native-NT "foo" ; | |
864 | assert.result "\\foo" : native-NT "/foo" ; | |
865 | assert.result "D:\\My Documents\\Work" : native-NT "/D:/My Documents/Work" ; | |
866 | ||
867 | modules.poke path : os : UNIX ; | |
868 | ||
869 | assert.result "foo/bar/giz" : make-UNIX "foo/bar/giz" ; | |
870 | assert.result "/sub1" : make-UNIX "/sub1/." ; | |
871 | assert.result "/sub1" : make-UNIX "/sub1/sub2/.." ; | |
872 | assert.result "sub1" : make-UNIX "sub1/." ; | |
873 | assert.result "sub1" : make-UNIX "sub1/sub2/.." ; | |
874 | assert.result "/foo/bar" : native-UNIX "/foo/bar" ; | |
875 | ||
876 | modules.poke path : os : VMS ; | |
877 | ||
878 | ## On VMS use POSIX-style path (keep previous tests commented out). | |
879 | ||
880 | assert.result "foo/bar/giz" : make-VMS "foo/bar/giz" ; | |
881 | assert.result "/sub1" : make-VMS "/sub1/." ; | |
882 | assert.result "/sub1" : make-VMS "/sub1/sub2/.." ; | |
883 | assert.result "sub1" : make-VMS "sub1/." ; | |
884 | assert.result "sub1" : make-VMS "sub1/sub2/.." ; | |
885 | assert.result "/foo/bar" : native-VMS "/foo/bar" ; | |
886 | ||
887 | ## | |
888 | ## Do not really need to poke os before these | |
889 | ## | |
890 | #assert.result "disk:" "[dir]" "file" : split-path-VMS "disk:[dir]file" ; | |
891 | #assert.result "disk:" "[dir]" "" : split-path-VMS "disk:[dir]" ; | |
892 | #assert.result "disk:" "" "" : split-path-VMS "disk:" ; | |
893 | #assert.result "disk:" "" "file" : split-path-VMS "disk:file" ; | |
894 | #assert.result "" "[dir]" "file" : split-path-VMS "[dir]file" ; | |
895 | #assert.result "" "[dir]" "" : split-path-VMS "[dir]" ; | |
896 | #assert.result "" "" "file" : split-path-VMS "file" ; | |
897 | #assert.result "" "" "" : split-path-VMS "" ; | |
898 | # | |
899 | ## | |
900 | ## Special case: current directory | |
901 | ## | |
902 | #assert.result "" "[]" "" : split-path-VMS "[]" ; | |
903 | #assert.result "disk:" "[]" "" : split-path-VMS "disk:[]" ; | |
904 | #assert.result "" "[]" "file" : split-path-VMS "[]file" ; | |
905 | #assert.result "disk:" "[]" "file" : split-path-VMS "disk:[]file" ; | |
906 | # | |
907 | ## | |
908 | ## Make portable paths | |
909 | ## | |
910 | #assert.result "/disk:" : make-VMS "disk:" ; | |
911 | #assert.result "foo/bar/giz" : make-VMS "[.foo.bar.giz]" ; | |
912 | #assert.result "foo" : make-VMS "[.foo]" ; | |
913 | #assert.result "foo" : make-VMS "[.foo.bar.-]" ; | |
914 | #assert.result ".." : make-VMS "[.-]" ; | |
915 | #assert.result ".." : make-VMS "[-]" ; | |
916 | #assert.result "." : make-VMS "[]" ; | |
917 | #assert.result "giz.h" : make-VMS "giz.h" ; | |
918 | #assert.result "foo/bar/giz.h" : make-VMS "[.foo.bar]giz.h" ; | |
919 | #assert.result "/disk:/my_docs" : make-VMS "disk:[my_docs]" ; | |
920 | #assert.result "/disk:/boost/tools/build/new/project.jam" : make-VMS | |
921 | # "disk:[boost.tools.build.test.-.new]project.jam" ; | |
922 | # | |
923 | ## | |
924 | ## Special case (adds '.' to end of file w/o extension to disambiguate from | |
925 | ## directory in portable path spec) | |
926 | ## | |
927 | #assert.result "Jamfile." : make-VMS "Jamfile" ; | |
928 | #assert.result "dir/Jamfile." : make-VMS "[.dir]Jamfile" ; | |
929 | #assert.result "/disk:/dir/Jamfile." : make-VMS "disk:[dir]Jamfile" ; | |
930 | # | |
931 | ## | |
932 | ## Make native paths | |
933 | ## | |
934 | #assert.result "disk:" : native-VMS "/disk:" ; | |
935 | #assert.result "[.foo.bar.giz]" : native-VMS "foo/bar/giz" ; | |
936 | #assert.result "[.foo]" : native-VMS "foo" ; | |
937 | #assert.result "[.-]" : native-VMS ".." ; | |
938 | #assert.result "[.foo.-]" : native-VMS "foo/.." ; | |
939 | #assert.result "[]" : native-VMS "." ; | |
940 | #assert.result "disk:[my_docs.work]" : native-VMS "/disk:/my_docs/work" ; | |
941 | #assert.result "giz.h" : native-VMS "giz.h" ; | |
942 | #assert.result "disk:Jamfile." : native-VMS "/disk:Jamfile." ; | |
943 | #assert.result "disk:[my_docs.work]Jamfile." : native-VMS | |
944 | # "/disk:/my_docs/work/Jamfile." ; | |
945 | ||
946 | modules.poke path : os : $(save-os) ; | |
947 | } |