diff options
author | Jeffrey Armstrong <jeff@approximatrix.com> | 2022-02-18 09:54:40 -0500 |
---|---|---|
committer | Jeffrey Armstrong <jeff@approximatrix.com> | 2022-02-18 09:54:40 -0500 |
commit | c1ab3fc41cb1962db2a6909dfd07e8f088fadb8f (patch) | |
tree | 116899bceb26c3d90218cdedc0ecb832d32f024b /src/fpm_os.F90 | |
parent | 2c6148e0f9ceafc55da934b8b84299f05a3c030c (diff) | |
download | fpm-c1ab3fc41cb1962db2a6909dfd07e8f088fadb8f.tar.gz fpm-c1ab3fc41cb1962db2a6909dfd07e8f088fadb8f.zip |
Added detection of 32bit Windows and prepend -m32 flags when detected, specific to using a mingw64 multilib compiler. Moved default location to local app data.
Diffstat (limited to 'src/fpm_os.F90')
-rw-r--r-- | src/fpm_os.F90 | 75 |
1 files changed, 74 insertions, 1 deletions
diff --git a/src/fpm_os.F90 b/src/fpm_os.F90 index 71663fe..9b2be10 100644 --- a/src/fpm_os.F90 +++ b/src/fpm_os.F90 @@ -3,7 +3,7 @@ module fpm_os use fpm_error, only : error_t, fatal_error implicit none private - public :: change_directory, get_current_directory + public :: change_directory, get_current_directory, windows_is_wow64 #ifndef _WIN32 character(len=*), parameter :: pwd_env = "PWD" @@ -101,5 +101,78 @@ contains lhs = transfer(rhs(1:ii-1), lhs) end subroutine c_f_character + +#ifdef _WIN32 + function windows_is_wow64() result(wow64) + use iso_c_binding + implicit none + + logical(kind=c_bool), target::wow64 + + ! If compiled for 64-bit, then the answer is no +#ifndef __i386__ + + wow64 = .false. + +#else + + interface + function IsWow64Process(h, cptrbool) + type(c_ptr), value::h, cptrbool + logical(kind=c_bool)::IsWow64Process + end function IsWow64Process + end interface + + interface + function GetModuleHandle(str) bind(c) + character(len=*, kind=c_char)::str + type(c_ptr)::GetModuleHandle + end function GetModuleHandle + end interface + + interface + function GetProcAddress(libptr, str) bind(c) + type(c_ptr), value::libptr + character(len=*, kind=c_char)::str + type(c_funptr)::GetProcAddress + end function GetProcAddress + end interface + + interface + function GetCurrentProcess() bind(c) + type(c_ptr)::GetCurrentProcess + end function GetCurrentProcess + end interface + + type(c_funptr)::wow64_c + procedure(IsWow64Process), pointer::wow64_f + + + wow64_c = GetProcAddress( & + GetModuleHandle("kernel32"//c_null_char), & + "IsWow64Process"//c_null_char) + + if(wow64_c == c_null_funptr) then + wow64 = .false. + else + call c_f_procpointer(wow64_c, wow64_f) + if(.not. wow64_f(GetCurrentProcess(), c_loc(wow64))) then + wow64 = .false. + end if + end if +#endif + + end function windows_is_wow64 + +#else + + ! Non-windows systems... + function windows_is_wow64() + implicit none + logical::windows_is_wow64 + windows_is_wow64 = .false. + end function windows_is_wow64 + +#endif end module fpm_os |