@@ -45,7 +45,149 @@ index 8325cd8cfb..d0c4f8bc87 100644
4545
4646 #include "camlatomic.h"
4747
48- @@ -435,11 +436,13 @@ extern double caml_log1p(double);
48+ @@ -418,6 +419,141 @@ extern double caml_log1p(double);
49+ #define main_os wmain
50+ #endif
51+
52+ + static wchar_t * __cdecl _wdirname(wchar_t *path);
53+ +
54+ + // Adapted to wchar_t from
55+ + // https://github.com/Alexpux/mingw-w64/blob/master/mingw-w64-crt/misc/dirname.c
56+ +
57+ + #include <string.h>
58+ + #include <stdlib.h>
59+ + #include <wchar.h>
60+ +
61+ + static wchar_t * __cdecl
62+ + _wdirname(wchar_t *path)
63+ + {
64+ + static wchar_t *retfail = NULL;
65+ + size_t len = wcslen(path);
66+ +
67+ + if (path && *path)
68+ + {
69+ + wchar_t *refpath = path;
70+ +
71+ + /* SUSv3 identifies a special case, where path is exactly equal to "//";
72+ + * (we will also accept "\\" in the Win32 context, but not "/\" or "\/",
73+ + * and neither will we consider paths with an initial drive designator).
74+ + * For this special case, SUSv3 allows the implementation to choose to
75+ + * return "/" or "//", (or "\" or "\\", since this is Win32); we will
76+ + * simply return the path unchanged, (i.e. "//" or "\\"). */
77+ + if (len > 1 && (refpath[0] == L'/' || refpath[0] == L'\\'))
78+ + {
79+ + if (refpath[1] == refpath[0] && refpath[2] == L'\0')
80+ + {
81+ + return path;
82+ + }
83+ + }
84+ + /* For all other cases ...
85+ + * step over the drive designator, if present ... */
86+ + else if (len > 1 && refpath[1] == L':')
87+ + {
88+ + /* FIXME: maybe should confirm *refpath is a valid drive designator. */
89+ + refpath += 2;
90+ + }
91+ + /* check again, just to ensure we still have a non-empty path name ... */
92+ + if (*refpath)
93+ + {
94+ + # undef basename
95+ + # define basename __the_basename /* avoid shadowing. */
96+ + /* reproduce the scanning logic of the "basename" function
97+ + * to locate the basename component of the current path string,
98+ + * (but also remember where the dirname component starts). */
99+ + wchar_t *refname, *basename;
100+ + for (refname = basename = refpath; *refpath; ++refpath)
101+ + {
102+ + if (*refpath == L'/' || *refpath == L'\\')
103+ + {
104+ + /* we found a dir separator ...
105+ + * step over it, and any others which immediately follow it. */
106+ + while (*refpath == L'/' || *refpath == L'\\')
107+ + ++refpath;
108+ + /* if we didn't reach the end of the path string ... */
109+ + if (*refpath)
110+ + /* then we have a new candidate for the base name. */
111+ + basename = refpath;
112+ + else
113+ + /* we struck an early termination of the path string,
114+ + * with trailing dir separators following the base name,
115+ + * so break out of the for loop, to avoid overrun. */
116+ + break;
117+ + }
118+ + }
119+ + /* now check,
120+ + * to confirm that we have distinct dirname and basename components. */
121+ + if (basename > refname)
122+ + {
123+ + /* and, when we do ...
124+ + * backtrack over all trailing separators on the dirname component,
125+ + * (but preserve exactly two initial dirname separators, if identical),
126+ + * and add a NUL terminator in their place. */
127+ + do --basename;
128+ + while (basename > refname && (*basename == L'/' || *basename == L'\\'));
129+ + if (basename == refname && (refname[0] == L'/' || refname[0] == L'\\')
130+ + && refname[1] == refname[0] && refname[2] != L'/' && refname[2] != L'\\')
131+ + ++basename;
132+ + *++basename = L'\0';
133+ + /* if the resultant dirname begins with EXACTLY two dir separators,
134+ + * AND both are identical, then we preserve them. */
135+ + refpath = path;
136+ + while ((*refpath == L'/' || *refpath == L'\\'))
137+ + ++refpath;
138+ + if ((refpath - path) > 2 || path[1] != path[0])
139+ + refpath = path;
140+ + /* and finally ...
141+ + * we remove any residual, redundantly duplicated separators from the dirname,
142+ + * reterminate, and return it. */
143+ + refname = refpath;
144+ + while (*refpath)
145+ + {
146+ + if ((*refname++ = *refpath) == L'/' || *refpath++ == L'\\')
147+ + {
148+ + while (*refpath == L'/' || *refpath == L'\\')
149+ + ++refpath;
150+ + }
151+ + }
152+ + *refname = L'\0';
153+ + }
154+ + else
155+ + {
156+ + /* either there were no dirname separators in the path name,
157+ + * or there was nothing else ... */
158+ + if (*refname == L'/' || *refname == L'\\')
159+ + {
160+ + /* it was all separators, so return one. */
161+ + ++refname;
162+ + }
163+ + else
164+ + {
165+ + /* there were no separators, so return '.'. */
166+ + *refname++ = L'.';
167+ + }
168+ + /* add a NUL terminator, in either case,
169+ + * then transform to the multibyte char domain,
170+ + * using our own buffer. */
171+ + *refname = L'\0';
172+ + }
173+ + return path;
174+ + }
175+ + # undef basename
176+ + }
177+ + /* path is NULL, or an empty string; default return value is "." ...
178+ + * return this in our own buffer, regenerated by wide char transform,
179+ + * in case the caller trashed it after a previous call.
180+ + */
181+ + retfail = realloc(retfail, 2 * sizeof(wchar_t));
182+ + retfail[0] = L'.';
183+ + retfail[1] = L'\0';
184+ + return retfail;
185+ + }
186+ +
187+ #define access_os _waccess
188+ #define open_os _wopen
189+ #define stat_os _wstati64
190+ @@ -435,11 +571,13 @@ extern double caml_log1p(double);
49191 #define execvp_os _wexecvp
50192 #define execvpe_os _wexecvpe
51193 #define strcmp_os wcscmp
@@ -59,7 +201,7 @@ index 8325cd8cfb..d0c4f8bc87 100644
59201
60202 #define clock_os caml_win32_clock
61203
62- @@ -477,11 +480 ,13 @@ extern double caml_log1p(double);
204+ @@ -477,11 +615 ,13 @@ extern double caml_log1p(double);
63205 #define execvp_os execvp
64206 #define execvpe_os execvpe
65207 #define strcmp_os strcmp
0 commit comments