diff options
| -rw-r--r-- | fpm/src/FPM_Filesystem.f90 | 76 | ||||
| -rw-r--r-- | fpm/src/FPM_Strings.f90 | 23 | ||||
| -rw-r--r-- | fpm/src/environment.f90 | 14 | ||||
| -rw-r--r-- | fpm/src/fpm.f90 | 81 |
4 files changed, 115 insertions, 79 deletions
diff --git a/fpm/src/FPM_Filesystem.f90 b/fpm/src/FPM_Filesystem.f90 new file mode 100644 index 0000000..fe35066 --- /dev/null +++ b/fpm/src/FPM_Filesystem.f90 @@ -0,0 +1,76 @@ +module FPM_Filesystem +use FPM_Strings +use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS +implicit none + +private +public :: number_of_rows, list_files, exists + +integer, parameter :: LINE_BUFFER_LEN = 1000 + +contains + + +integer function number_of_rows(s) result(nrows) + ! determine number or rows + integer,intent(in)::s + integer :: ios + character(len=100) :: r + rewind(s) + nrows = 0 + do + read(s, *, iostat=ios) r + if (ios /= 0) exit + nrows = nrows + 1 + end do + rewind(s) +end function + +function read_lines(filename) result(lines) + character(*), intent(in) :: filename + type(string_t), allocatable :: lines(:) + + integer :: fh, i + character(LINE_BUFFER_LEN) :: line_buffer + + open(newunit=fh, file=filename, status="old") + allocate(lines(number_of_rows(fh))) + do i = 1, size(lines) + read(fh, *) line_buffer + lines(i)%s = trim(line_buffer) + end do + close(fh) + +end function read_lines + + +subroutine list_files(dir, files) + character(len=*), intent(in) :: dir + type(string_t), allocatable, intent(out) :: files(:) + integer :: stat + ! Using `inquire` / exists on directories works with gfortran, but not ifort + if (.not. exists(dir)) then + allocate(files(0)) + return + end if + select case (get_os_type()) + case (OS_LINUX) + call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) + case (OS_MACOS) + call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) + case (OS_WINDOWS) + call execute_command_line("dir /b " // dir // " > fpm_ls.out", exitstat=stat) + end select + if (stat /= 0) then + print *, "execute_command_line() failed" + error stop + end if + files = read_lines("fpm_ls.out") +end subroutine + +logical function exists(filename) result(r) + character(len=*), intent(in) :: filename + inquire(file=filename, exist=r) +end function + +end module FPM_Filesystem
\ No newline at end of file diff --git a/fpm/src/FPM_Strings.f90 b/fpm/src/FPM_Strings.f90 new file mode 100644 index 0000000..33ae0c4 --- /dev/null +++ b/fpm/src/FPM_Strings.f90 @@ -0,0 +1,23 @@ +module FPM_Strings +implicit none + +type string_t + character(len=:), allocatable :: s +end type + +contains + +logical function str_ends_with(s, e) result(r) + character(*), intent(in) :: s, e + integer :: n1, n2 + n1 = len(s)-len(e)+1 + n2 = len(s) + if (n1 < 1) then + r = .false. + else + r = (s(n1:n2) == e) + end if +end function + + +end module FPM_Strings
\ No newline at end of file diff --git a/fpm/src/environment.f90 b/fpm/src/environment.f90 index 9190eb6..23cd8aa 100644 --- a/fpm/src/environment.f90 +++ b/fpm/src/environment.f90 @@ -6,7 +6,7 @@ module environment integer, parameter, public :: OS_MACOS = 2 integer, parameter, public :: OS_WINDOWS = 3 - public :: get_os_type + public :: get_os_type, run contains integer function get_os_type() result(r) ! Determine the OS type @@ -51,4 +51,16 @@ contains r = OS_LINUX end if end function + + subroutine run(cmd) + character(len=*), intent(in) :: cmd + integer :: stat + print *, "+ ", cmd + call execute_command_line(cmd, exitstat=stat) + if (stat /= 0) then + print *, "Command failed" + error stop + end if + end subroutine + end module diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index ed80313..26a4631 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,89 +1,14 @@ module fpm -use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS +use FPM_Strings +use environment, only: run, get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS +use FPM_Filesystem, only: number_of_rows, list_files, exists implicit none private public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test -type string_t - character(len=:), allocatable :: s -end type contains -integer function number_of_rows(s) result(nrows) -! determine number or rows -integer,intent(in)::s -integer :: ios -character(len=100) :: r -rewind(s) -nrows = 0 -do - read(s, *, iostat=ios) r - if (ios /= 0) exit - nrows = nrows + 1 -end do -rewind(s) -end function - - -subroutine list_files(dir, files) -character(len=*), intent(in) :: dir -type(string_t), allocatable, intent(out) :: files(:) -character(len=100) :: filename -integer :: stat, u, i -! Using `inquire` / exists on directories works with gfortran, but not ifort -if (.not. exists(dir)) then - allocate(files(0)) - return -end if -select case (get_os_type()) - case (OS_LINUX) - call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) - case (OS_MACOS) - call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) - case (OS_WINDOWS) - call execute_command_line("dir /b " // dir // " > fpm_ls.out", exitstat=stat) -end select -if (stat /= 0) then - print *, "execute_command_line() failed" - error stop -end if -open(newunit=u, file="fpm_ls.out", status="old") -allocate(files(number_of_rows(u))) -do i = 1, size(files) - read(u, *) filename - files(i)%s = trim(filename) -end do -close(u) -end subroutine - -subroutine run(cmd) -character(len=*), intent(in) :: cmd -integer :: stat -print *, "+ ", cmd -call execute_command_line(cmd, exitstat=stat) -if (stat /= 0) then - print *, "Command failed" - error stop -end if -end subroutine - -logical function exists(filename) result(r) -character(len=*), intent(in) :: filename -inquire(file=filename, exist=r) -end function - -logical function str_ends_with(s, e) result(r) -character(*), intent(in) :: s, e -integer :: n1, n2 -n1 = len(s)-len(e)+1 -n2 = len(s) -if (n1 < 1) then - r = .false. -else - r = (s(n1:n2) == e) -end if -end function subroutine package_name(name) character(:), allocatable, intent(out) :: name |