Fri, 14 Jun 2013 13:30:14 +0200
8016520: jdk native build does not fail on compilation error on windows
Reviewed-by: tbell
1 #!/bin/perl
3 #
4 # Copyright (c) 2012, Oracle and/or its affiliates. All rights reserved.
5 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
6 #
7 # This code is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License version 2 only, as
9 # published by the Free Software Foundation. Oracle designates this
10 # particular file as subject to the "Classpath" exception as provided
11 # by Oracle in the LICENSE file that accompanied this code.
12 #
13 # This code is distributed in the hope that it will be useful, but WITHOUT
14 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 # version 2 for more details (a copy is included in the LICENSE file that
17 # accompanied this code).
18 #
19 # You should have received a copy of the GNU General Public License version
20 # 2 along with this work; if not, write to the Free Software Foundation,
21 # Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
22 #
23 # Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
24 # or visit www.oracle.com if you need additional information or have any
25 # questions.
26 #
28 # Crunch down the input(s) to Windows short (mangled) form.
29 # Any elements not actually found in the filesystem will be dropped.
30 #
31 # This script needs three modes:
32 # 1) DOS mode with drive letter followed by : and ; path separator
33 # 2) Cygwin mode with /cygdrive/<drive letter>/ and : path separator
34 # 3) MinGW/MSYS mode with /<drive letter>/ and : path separator
36 use strict;
37 use warnings;
38 use Getopt::Std;
40 sub Usage() {
41 print ("Usage:\n $0 -d | -c | -m \<PATH\>\n");
42 print (" -d DOS style (drive letter, :, and ; path separator)\n");
43 print (" -c Cywgin style (/cygdrive/drive/ and : path separator)\n");
44 print (" -m MinGW style (/drive/ and : path separator)\n");
45 exit 1;
46 }
47 # Process command line options:
48 my %opts;
49 getopts('dcm', \%opts) || Usage();
51 if (scalar(@ARGV) != 1) {Usage()};
53 # Translate drive letters such as C:/
54 # if MSDOS, Win32::GetShortPathName() does the work (see below).
55 # if Cygwin, use the /cygdrive/c/ form.
56 # if MinGW, use the /c/ form.
57 my $path0;
58 my $sep2;
59 if (defined ($opts{'d'})) {
60 #MSDOS
61 $path0 = '';
62 $sep2 = ';';
63 } elsif (defined ($opts{'c'})) {
64 #Cygwin
65 $path0 = '/cygdrive';
66 $sep2 = ':';
67 } elsif (defined ($opts{'m'})) {
68 #MinGW/MSYS
69 $path0 = '';
70 $sep2 = ':';
71 } else {
72 Usage();
73 }
75 my $input = $ARGV[0];
76 my $sep1;
78 # Is the input ';' separated, or ':' separated, or a simple string?
79 if (($input =~ tr/;/;/) > 0) {
80 # One or more ';' implies Windows style path.
81 $sep1 = ';';
82 } elsif (($input =~ tr/:/:/) > 1) {
83 # Two or more ':' implies Cygwin or MinGW/MSYS style path.
84 $sep1 = ':';
85 } else {
86 # Otherwise, this is not a path - take up to the end of string in
87 # one piece.
88 $sep1 = '/$/';
89 }
91 # Split the input on $sep1 PATH separator and process the pieces.
92 my @pieces;
93 for (split($sep1, $input)) {
94 my $try = $_;
96 if (($try =~ /^\/cygdrive\/(.)\/(.*)$/) || ($try =~ /^\/(.)\/(.*)$/)) {
97 # Special case #1: This is a Cygwin /cygrive/<drive letter/ path.
98 # Special case #2: This is a MinGW/MSYS /<drive letter/ path.
99 $try = $1.':/'.$2;
100 } elsif ($try =~ /^\/(.*)$/) {
101 # Special case #3: check for a Cygwin or MinGW/MSYS form with a
102 # leading '/' for example '/usr/bin/bash'.
103 # Look up where this is mounted and rebuild the
104 # $try string with that information
105 my $cmd = "df --portability --all --human-readable $try";
106 my $line = qx ($cmd);
107 my $status = $?;
108 if ($status == 0) {
109 my @lines = split ('\n', $line);
110 my ($device, $junk, $mountpoint);
111 # $lines[0] is the df header.
112 # Example string for split - we want the first and last elements:
113 # C:\jprt\products\P1\MinGW\msys\1.0 200G 78G 123G 39% /usr
114 ($device, $junk, $junk, $junk, $junk, $mountpoint) = split (/\s+/, $lines[1]);
115 # Replace $mountpoint with $device/ in the original string
116 $try =~ s|$mountpoint|$device/|;
117 } else {
118 printf ("Error %d from command %s\n%s\n", $status, $cmd, $line);
119 }
120 }
122 my $str = Win32::GetShortPathName($try);
123 if (!defined($str)){
124 # Special case #4: If the lookup did not work, loop through
125 # adding extensions listed in PATHEXT, looking for the first
126 # match.
127 for (split(';', $ENV{'PATHEXT'})) {
128 $str = Win32::GetShortPathName($try.$_);
129 if (defined($str)) {
130 last;
131 }
132 }
133 }
135 if (defined($str)){
136 if (!defined($opts{'d'})) {
137 # If not MSDOS, change C: to [/cygdrive]/c/
138 if ($str =~ /^(\S):(.*)$/) {
139 my $path1 = $1;
140 my $path2 = $2;
141 $str = $path0 . '/' . $path1 . '/' . $path2;
142 }
143 }
144 push (@pieces, $str);
145 }
146 }
148 # If input was a PATH, join the pieces back together with $sep2 path
149 # separator.
150 my $result;
151 if (scalar(@pieces > 1)) {
152 $result = join ($sep2, @pieces);
153 } else {
154 $result = $pieces[0];
155 }
157 if (defined ($result)) {
159 # Change all '\' to '/'
160 $result =~ s/\\/\//g;
162 # Remove duplicate '/'
163 $result =~ s/\/\//\//g;
165 # Map to lower case
166 $result =~ tr/A-Z/a-z/;
168 print ("$result\n");
169 }