WINDOWS: make env.jl and file.jl unicode-complient for JuliaLang#4240,…

… with error-message handling

base/env.jl

@@ -5,69 +5,93 @@
  _hasenv(s::String) = _getenv(s) != C_NULL
 end
 @windows_only begin
-_getenvlen(var::String) = ccall(:GetEnvironmentVariableA,stdcall,Uint32,(Ptr{Uint8},Ptr{Uint8},Uint32),var,C_NULL,0)
-_hasenv(s::String) = _getenvlen(s)!=0
-function _jl_win_getenv(s::String,len::Uint32)
- val=zeros(Uint8,len-1)
- ret=ccall(:GetEnvironmentVariableA,stdcall,Uint32,(Ptr{Uint8},Ptr{Uint8},Uint32),s,val,len)
- if ret==0||ret!=len-1 #Trailing 0 is only included on first call to GetEnvA
- error("unknown system error: ", s, len, ret)
+const ERROR_ENVVAR_NOT_FOUND = uint32(203)
+const FORMAT_MESSAGE_ALLOCATE_BUFFER = uint32(0x100)
+const FORMAT_MESSAGE_FROM_SYSTEM = uint32(0x1000)
+const FORMAT_MESSAGE_IGNORE_INSERTS = uint32(0x200)
+const FORMAT_MESSAGE_MAX_WIDTH_MASK = uint32(0xFF)
+GetLastError() = ccall(:GetLastError,stdcall,Uint32,())
+function FormatMessage(e=GetLastError())
+ lpMsgBuf = Array(Ptr{Uint16})
+ lpMsgBuf[1] = 0
+ len = ccall(:FormatMessageW,stdcall,Uint32,(Cint, Ptr{Void}, Cint, Cint, Ptr{Ptr{Uint16}}, Cint, Ptr{Void}),
+ FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS | FORMAT_MESSAGE_MAX_WIDTH_MASK,
+ C_NULL, e, 0, lpMsgBuf, 0, C_NULL)
+ p = lpMsgBuf[1]
+ len == 0 && return utf8("")
+ len = len + 1
+ buf = Array(Uint16, len)
+ unsafe_copy!(pointer(buf), p, len)
+ ccall(:LocalFree,stdcall,Ptr{Void},(Ptr{Void},),p)
+ return utf8(UTF16String(buf))
+end
+
+_getenvlen(var::UTF16String) = ccall(:GetEnvironmentVariableW,stdcall,Uint32,(Ptr{Uint16},Ptr{Uint8},Uint32),utf16(var),C_NULL,0)
+_hasenv(s::UTF16String) = _getenvlen(s)!=0 || GetLastError()!=ERROR_ENVVAR_NOT_FOUND
+_hasenv(s::String) = _hasenv(utf16(s))
+function _jl_win_getenv(s::UTF16String,len::Uint32)
+ val=zeros(Uint16,len)
+ ret=ccall(:GetEnvironmentVariableW,stdcall,Uint32,(Ptr{Uint16},Ptr{Uint16},Uint32),s,val,len)
+ if ret==0 || ret != len-1 || val[end] != 0
+ error(string("system error getenv: ", s, ' ', len, "-1 != ", ret, ": ", FormatMessage()))
  end
  val
 end
 end
 
-
 macro accessEnv(var,errorcase)
-@unix_only return quote
- val=_getenv($(esc(var)))
- if val == C_NULL
- $(esc(errorcase))
- end
- bytestring(val)
-end
-@windows_only return quote
- len=_getenvlen($(esc(var)))
- if len == 0
- $(esc(errorcase))
+ @unix_only return quote
+ val=_getenv($(esc(var)))
+ if val == C_NULL
+ $(esc(errorcase))
+ end
+ bytestring(val)
+ end
+ @windows_only return quote
+ let var = utf16($(esc(var)))
+ len=_getenvlen(var)
+ if len == 0
+ if GetLastError() != ERROR_ENVVAR_NOT_FOUND
+ return utf8("")
+ else
+ $(esc(errorcase))
+ end
+ end
+ utf8(UTF16String(_jl_win_getenv(var,len)))
+ end
  end
- bytestring(_jl_win_getenv($(esc(var)),len))
-end
 end
 
 function _setenv(var::String, val::String, overwrite::Bool)
-@unix_only begin
- ret = ccall(:setenv, Int32, (Ptr{Uint8},Ptr{Uint8},Int32), var, val, overwrite)
- systemerror(:setenv, ret != 0)
-end
-@windows_only begin
- if overwrite||!_hasenv(var)
- ret = ccall(:SetEnvironmentVariableA,stdcall,Int32,(Ptr{Uint8},Ptr{Uint8}),var,val)
- systemerror(:setenv, ret == 0)
+ @unix_only begin
+ ret = ccall(:setenv, Int32, (Ptr{Uint8},Ptr{Uint8},Int32), var, val, overwrite)
+ systemerror(:setenv, ret != 0)
+ end
+ @windows_only begin
+ var = utf16(var)
+ if overwrite || !_hasenv(var)
+ ret = ccall(:SetEnvironmentVariableW,stdcall,Int32,(Ptr{Uint16},Ptr{Uint16}),utf16(var),utf16(val))
+ systemerror(:setenv, ret == 0)
+ end
  end
-end
 end
 
 _setenv(var::String, val::String) = _setenv(var, val, true)
 
 function _unsetenv(var::String)
-@unix_only begin
- ret = ccall(:unsetenv, Int32, (Ptr{Uint8},), var)
- systemerror(:unsetenv, ret != 0)
-end
-@windows_only begin
- ret = ccall(:SetEnvironmentVariableA,stdcall,Int32,(Ptr{Uint8},Ptr{Uint8}),var,C_NULL)
- systemerror(:setenv, ret == 0)
-end
+ @unix_only begin
+  ret = ccall(:unsetenv, Int32, (Ptr{Uint8},), var)
+  systemerror(:unsetenv, ret != 0)
+ end
+ @windows_only begin
+  ret = ccall(:SetEnvironmentVariableW,stdcall,Int32,(Ptr{Uint16},Ptr{Uint16}),utf16(var),C_NULL)
+  systemerror(:setenv, ret == 0)
+ end
 end
 
 ## ENV: hash interface ##
 
-@unix_only type EnvHash <: Associative{ByteString,ByteString}; end
-@windows_only type EnvHash <: Associative{ByteString,ByteString}
- block::Ptr{Uint8}
- EnvHash() = new(C_NULL)
-end
+type EnvHash <: Associative{ByteString,ByteString}; end
 const ENV = EnvHash()
 
 similar(::EnvHash) = Dict{ByteString,ByteString}()
@@ -108,23 +132,26 @@ end
 end
 
 @windows_only begin
-start(hash::EnvHash) = (hash.block = ccall(:GetEnvironmentStringsA,stdcall,Ptr{Uint8},()))
-function done(hash::EnvHash, pos::Ptr{Uint8})
- if ccall(:jl_env_done,Any,(Ptr{Uint8},),pos)::Bool
- ccall(:FreeEnvironmentStringsA,stdcall,Int32,(Ptr{Uint8},),hash.block)
- hash.block=C_NULL
+start(hash::EnvHash) = (pos = ccall(:GetEnvironmentStringsW,stdcall,Ptr{Uint16},()); (pos,pos))
+function done(hash::EnvHash, block::(Ptr{Uint16},Ptr{Uint16}))
+ if unsafe_load(block[1])==0
+ ccall(:FreeEnvironmentStringsW,stdcall,Int32,(Ptr{Uint16},),block[2])
  return true
  end
  false
 end
-function next(hash::EnvHash, pos::Ptr{Uint8})
- len = ccall(:strlen, Uint, (Ptr{Uint8},), pos)
- env=ccall(:jl_pchar_to_string, Any, (Ptr{Uint8},Int), pos, len)::ByteString
- m = match(r"^(.*?)=(.*)$"s, env)
+function next(hash::EnvHash, block::(Ptr{Uint16},Ptr{Uint16}))
+ pos = block[1]
+ blk = block[2]
+ len = ccall(:wcslen, Uint, (Ptr{Uint16},), pos)+1
+ buf = Array(Uint16, len)
+ unsafe_copy!(pointer(buf), pos, len)
+ env = utf8(UTF16String(buf))
+ m = match(r"^(=?[^=]+)=(.*)$"s, env)
  if m == nothing
  error("malformed environment entry: $env")
  end
- (ByteString[convert(typeof(env),x) for x in m.captures], pos+len+1)
+ (ByteString[convert(typeof(env),x) for x in m.captures], (pos+len*2, blk))
 end
 end
 

base/file.jl

@@ -36,7 +36,7 @@ cd(f::Function) = cd(f, homedir())
 
 function mkdir(path::String, mode::Unsigned=0o777)
  @unix_only ret = ccall(:mkdir, Int32, (Ptr{Uint8},Uint32), bytestring(path), mode)
- @windows_only ret = ccall(:_mkdir, Int32, (Ptr{Uint8},), bytestring(path))
+ @windows_only ret = ccall(:_wmkdir, Int32, (Ptr{Uint16},), utf16(path))
  systemerror(:mkdir, ret != 0)
 end
 
@@ -66,13 +66,24 @@ touch(path::String) = run(`touch $path`)
 
 # Obtain a temporary filename.
 function tempname()
- d = get(ENV, "TMPDIR", C_NULL) # tempnam ignores TMPDIR on darwin
- @unix_only p = ccall(:tempnam, Ptr{Uint8}, (Ptr{Uint8},Ptr{Uint8}), d, "julia")
- @windows_only p = ccall(:_tempnam, Ptr{Uint8}, (Ptr{Uint8},Ptr{Uint8}), d, "julia")
- systemerror(:tempnam, p == C_NULL)
- s = bytestring(p)
- c_free(p)
- s
+ @unix_only begin
+ d = get(ENV, "TMPDIR", C_NULL) # tempnam ignores TMPDIR on darwin
+ p = ccall(:tempnam, Ptr{Uint8}, (Ptr{Uint8},Ptr{Uint8}), d, "julia")
+ systemerror(:tempnam, p == C_NULL)
+ s = bytestring(p)
+ c_free(p)
+ return s
+ end
+ @windows_only begin
+ d = get(ENV, "TMPDIR", C_NULL)
+ p = ccall(:_wtempnam, Ptr{Uint16}, (Ptr{Uint16},Ptr{Uint16}), d!=C_NULL?utf16(d):C_NULL, utf16("julia"))
+ systemerror(:tempnam, p == C_NULL)
+ len = ccall(:wcslen, Uint, (Ptr{Uint16},), p)+1
+ buf = Array(Uint16, len)
+ unsafe_copy!(pointer(buf), p, len)
+ c_free(p)
+ return utf8(UTF16String(buf))
+ end
 end
 
 # Obtain a temporary directory's path.
@@ -87,27 +98,28 @@ end
 
 @windows_only begin 
 function GetTempPath()
- temppath = Array(Uint8,261)
- lentemppath = ccall(:GetTempPathA,stdcall,Uint32,(Uint32,Ptr{Uint8}),length(temppath),temppath)
+ temppath = Array(Uint16,261)
+ lentemppath = ccall(:GetTempPathW,stdcall,Uint32,(Uint32,Ptr{Uint16}),length(temppath),temppath)
  if lentemppath >= length(temppath) || lentemppath == 0
- error("GetTempPath failed")
+ error("GetTempPath failed: $(FormatMessage())")
  end
- resize!(temppath,lentemppath)
- return convert(ASCIIString,temppath)
+ resize!(temppath,lentemppath+1)
+ return utf8(UTF16String(temppath))
 end
-GetTempFileName(uunique::Uint32) = GetTempFileName(GetTempPath(), uunique)
+GetTempFileName(uunique::Uint32=uint32(0)) = GetTempFileName(GetTempPath(), uunique)
 function GetTempFileName(temppath::String,uunique::Uint32)
- tname = Array(Uint8,261)
- uunique = ccall(:GetTempFileNameA,stdcall,Uint32,(Ptr{Uint8},Ptr{Uint8},Uint32,Ptr{Uint8}),temppath,"julia",uunique,tname)
+ tname = Array(Uint16,261)
+ uunique = ccall(:GetTempFileNameW,stdcall,Uint32,(Ptr{Uint16},Ptr{Uint16},Uint32,Ptr{Uint16}),
+ utf16(temppath),utf16("julia"),uunique,tname)
  lentname = findfirst(tname,0)-1
  if uunique == 0 || lentname <= 0
- error("GetTempFileName failed")
+ error("GetTempFileName failed: $(FormatMessage())")
  end
- resize!(tname,lentname)
- return convert(ASCIIString, tname)
+ resize!(tname,lentname+1)
+ return utf8(UTF16String(tname))
 end
 function mktemp()
- filename = GetTempFileName(uint32(0))
+ filename = GetTempFileName()
  return (filename, open(filename,"r+"))
 end
 end
@@ -120,10 +132,10 @@ end
 end
 
 @windows_only function mktempdir()
- seed = rand(Uint32)
+ seed::Uint32 = rand(Uint32)
  while true
  filename = GetTempFileName(seed)
- ret = ccall(:_mkdir, Int32, (Ptr{Uint8},), filename)
+ ret = ccall(:_wmkdir, Int32, (Ptr{Uint16},), utf16(filename))
  if ret == 0
  return filename
  end

src/julia.h

@@ -817,9 +817,6 @@ DLLEXPORT int jl_is_debugbuild(void);
 
 // environment entries
 DLLEXPORT jl_value_t *jl_environ(int i);
-#ifdef _OS_WINDOWS_
-DLLEXPORT jl_value_t *jl_env_done(char *pos);
-#endif
 
 // throwing common exceptions
 DLLEXPORT void NORETURN jl_error(const char *str);

src/sys.c

@@ -376,12 +376,6 @@ jl_value_t *jl_environ(int i)
  char *env = environ[i];
  return env ? jl_pchar_to_string(env, strlen(env)) : jl_nothing;
 }
-#ifdef _OS_WINDOWS_
-jl_value_t *jl_env_done(char *pos)
-{
- return (*pos==0)?jl_true:jl_false;
-}
-#endif
 
 // -- child process status --