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