From 7b8f2ab32f66d8f3ce48a5e9685c05b25d31f2bb Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Mon, 10 Aug 2020 18:02:04 -0400 Subject: Fixed favorite loading that caused string filling and pointer crashes. Now calls win32 CreateDirectory on Windows. Fixed Fave button on Windows. --- platform.F90 | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) (limited to 'platform.F90') diff --git a/platform.F90 b/platform.F90 index 7fbe389..7c864b1 100644 --- a/platform.F90 +++ b/platform.F90 @@ -12,12 +12,30 @@ implicit none contains subroutine make_directory(dir) + use iso_c_binding implicit none character(*), intent(in)::dir #ifdef WINDOWS - call execute_command_line('mkdir "'//trim(dir)//'"') + character(kind=c_char, len=:), allocatable, target::passdir + interface + function CreateDirectory(dir, ignored) bind(c, name="CreateDirectoryA") + use iso_c_binding + type(c_ptr), value::dir + type(c_ptr), value::ignored + integer(kind=c_int)::CreateDirectory + end function CreateDirectory + end interface + + allocate(character(len=(len_trim(dir)+1)) :: passdir) + passdir = trim(dir)//c_null_char + if(CreateDirectory(c_loc(passdir), c_null_ptr) == 0) then + print *, "Could not create directory, maybe exists?" + end if + deallocate(passdir) + + !call execute_command_line('mkdir "'//trim(dir)//'"') #else call execute_command_line('mkdir -p "'//trim(dir)//'"') #endif -- cgit v1.2.3