From c1ab3fc41cb1962db2a6909dfd07e8f088fadb8f Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Fri, 18 Feb 2022 09:54:40 -0500 Subject: 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. --- src/fpm/installer.f90 | 9 ++++-- src/fpm_compiler.f90 | 16 ++++++++++- src/fpm_environment.f90 | 19 +++++++++++++ src/fpm_os.F90 | 75 ++++++++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 114 insertions(+), 5 deletions(-) diff --git a/src/fpm/installer.f90 b/src/fpm/installer.f90 index d01bd27..70426d5 100644 --- a/src/fpm/installer.f90 +++ b/src/fpm/installer.f90 @@ -61,7 +61,7 @@ module fpm_installer character(len=*), parameter :: default_prefix_unix = "/usr/local" !> Default name of the installation prefix on Windows platforms - character(len=*), parameter :: default_prefix_win = "C:\" + character(len=*), parameter :: default_prefix_win = "C:\fpm" !> Copy command on Unix platforms character(len=*), parameter :: default_copy_unix = "cp" @@ -150,9 +150,12 @@ contains prefix = default_prefix_unix end if else - call env_variable(home, "APPDATA") + call env_variable(home, "LOCALAPPDATA") + if (.not. allocated(home)) then + call env_variable(home, "APPDATA") + end if if (allocated(home)) then - prefix = join_path(home, "local") + prefix = join_path(home, "fpm") else prefix = default_prefix_win end if diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index d94963c..e8e97f4 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -29,6 +29,7 @@ module fpm_compiler use fpm_environment, only: & get_env, & get_os_type, & + os_is_32bit_windows, & OS_LINUX, & OS_MACOS, & OS_WINDOWS, & @@ -133,7 +134,8 @@ character(*), parameter :: & flag_gnu_warn = " -Wall -Wextra -Wimplicit-interface", & flag_gnu_check = " -fcheck=bounds -fcheck=array-temps", & flag_gnu_limit = " -fmax-errors=1", & - flag_gnu_external = " -Wimplicit-interface" + flag_gnu_external = " -Wimplicit-interface", & + flag_gnu_32bit = " -m32" character(*), parameter :: & flag_pgi_backslash = " -Mbackslash", & @@ -194,6 +196,8 @@ function get_default_flags(self, release) result(flags) end function get_default_flags subroutine get_release_compile_flags(id, flags) + implicit none + integer(compiler_enum), intent(in) :: id character(len=:), allocatable, intent(out) :: flags @@ -215,6 +219,10 @@ subroutine get_release_compile_flags(id, flags) flag_gnu_pic//& flag_gnu_limit//& flag_gnu_coarray + + if(os_is_32bit_windows()) then + flags = flag_gnu_32bit//flags + end if case(id_f95) flags = & @@ -286,6 +294,8 @@ subroutine get_release_compile_flags(id, flags) end subroutine get_release_compile_flags subroutine get_debug_compile_flags(id, flags) + implicit none + integer(compiler_enum), intent(in) :: id character(len=:), allocatable, intent(out) :: flags @@ -309,6 +319,10 @@ subroutine get_debug_compile_flags(id, flags) flag_gnu_check//& flag_gnu_backtrace//& flag_gnu_coarray + if(os_is_32bit_windows()) then + flags = flag_gnu_32bit//flags + end if + case(id_f95) flags = & flag_gnu_warn//& diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 7926703..33a584b 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -14,6 +14,7 @@ module fpm_environment public :: get_env public :: get_command_arguments_quoted public :: separator + public :: os_is_32bit_windows integer, parameter, public :: OS_UNKNOWN = 0 integer, parameter, public :: OS_LINUX = 1 @@ -155,6 +156,24 @@ contains end if unix = build_os /= OS_WINDOWS end function os_is_unix + + logical function os_is_32bit_windows(os) result(win_32bit) + use fpm_os, only: windows_is_wow64 + implicit none + integer, intent(in), optional :: os + integer :: build_os + if (present(os)) then + build_os = os + else + build_os = get_os_type() + end if + + if(build_os == OS_WINDOWS) then + win_32bit = .not. windows_is_wow64() + else + win_32bit = .false. + end if + end function os_is_32bit_windows !> get named environment variable value. It it is blank or !! not set return the optional default value 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 -- cgit v1.2.3