From d7f5156e4d533a691f0ccf36d08504bf1adeef57 Mon Sep 17 00:00:00 2001 From: Brad Richardson Date: Thu, 30 Jul 2020 17:10:24 -0700 Subject: Refactor to make it easier to start developing the command line aspects --- fpm/.gitignore | 1 + fpm/app/main.f90 | 50 +++++++++++++++++-------------- fpm/src/command_line.f90 | 78 ++++++++++++++++++++++++++++++++++++++++++++++++ fpm/src/environment.f90 | 54 +++++++++++++++++++++++++++++++++ fpm/src/fpm.f90 | 73 ++------------------------------------------ 5 files changed, 162 insertions(+), 94 deletions(-) create mode 100644 fpm/.gitignore create mode 100644 fpm/src/command_line.f90 create mode 100644 fpm/src/environment.f90 diff --git a/fpm/.gitignore b/fpm/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/fpm/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/fpm/app/main.f90 b/fpm/app/main.f90 index 361cae5..30abf5b 100644 --- a/fpm/app/main.f90 +++ b/fpm/app/main.f90 @@ -1,27 +1,31 @@ program main -use fpm, only: print_help, cmd_build, cmd_install, cmd_new, cmd_run, cmd_test +use command_line, only: & + fpm_cmd_settings, & + fpm_new_settings, & + fpm_build_settings, & + fpm_run_settings, & + fpm_test_settings, & + fpm_install_settings, & + get_command_line_settings +use fpm, only: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test + implicit none -character(100) :: cmdarg -if (command_argument_count() == 0) then - call print_help() -else if (command_argument_count() == 1) then - call get_command_argument(1, cmdarg) - select case(trim(cmdarg)) - case("build") - call cmd_build() - case("install") - call cmd_install() - case("new") - call cmd_new() - case("run") - call cmd_run() - case default - print *, "fpm error: No such command " // trim(cmdarg) - error stop 1 - end select -else - print *, "Too many arguments" - error stop 1 -end if +class(fpm_cmd_settings), allocatable :: cmd_settings + +call get_command_line_settings(cmd_settings) + +select type(cmd_settings) +type is (fpm_new_settings) + call cmd_new() +type is (fpm_build_settings) + call cmd_build() +type is (fpm_run_settings) + call cmd_run() +type is (fpm_test_settings) + call cmd_test() +type is (fpm_install_settings) + call cmd_install() +end select + end program main diff --git a/fpm/src/command_line.f90 b/fpm/src/command_line.f90 new file mode 100644 index 0000000..cd78904 --- /dev/null +++ b/fpm/src/command_line.f90 @@ -0,0 +1,78 @@ +module command_line + use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS + + implicit none + private + + type, public, abstract :: fpm_cmd_settings + end type + + type, public, extends(fpm_cmd_settings) :: fpm_new_settings + end type + + type, public, extends(fpm_cmd_settings) :: fpm_build_settings + end type + + type, public, extends(fpm_cmd_settings) :: fpm_run_settings + end type + + type, public, extends(fpm_cmd_settings) :: fpm_test_settings + end type + + type, public, extends(fpm_cmd_settings) :: fpm_install_settings + end type + + public :: get_command_line_settings +contains + subroutine get_command_line_settings(cmd_settings) + class(fpm_cmd_settings), allocatable, intent(out) :: cmd_settings + + character(len=100) :: cmdarg + + if (command_argument_count() == 0) then + call print_help() + else if (command_argument_count() == 1) then + call get_command_argument(1, cmdarg) + select case(trim(cmdarg)) + case("new") + allocate(fpm_new_settings :: cmd_settings) + case("build") + allocate(fpm_build_settings :: cmd_settings) + case("run") + allocate(fpm_run_settings :: cmd_settings) + case("test") + allocate(fpm_test_settings :: cmd_settings) + case("install") + allocate(fpm_install_settings :: cmd_settings) + case default + print *, "fpm error: No such command " // trim(cmdarg) + error stop 1 + end select + else + print *, "Too many arguments" + error stop 1 + end if + end subroutine + + subroutine print_help() + print *, "fpm - A Fortran package manager and build system" + select case (get_os_type()) + case (OS_LINUX) + print *, "OS Type: Linux" + case (OS_MACOS) + print *, "OS Type: macOS" + case (OS_WINDOWS) + print *, "OS Type: Windows" + end select + print * + print *, "Usage:" + print *, " fpm [COMMAND]" + print * + print *, "Valid fpm commands are:" + print *, " build Compile the current package" + print *, " install Install a Fortran binary or library (not implemented)" + print *, " new Create a new Fortran package (not implemented)" + print *, " run Run a binary of the local package (not implemented)" + print *, " test Run the tests (not implemented)" + end subroutine +end module command_line diff --git a/fpm/src/environment.f90 b/fpm/src/environment.f90 new file mode 100644 index 0000000..9190eb6 --- /dev/null +++ b/fpm/src/environment.f90 @@ -0,0 +1,54 @@ +module environment + implicit none + private + + integer, parameter, public :: OS_LINUX = 1 + integer, parameter, public :: OS_MACOS = 2 + integer, parameter, public :: OS_WINDOWS = 3 + + public :: get_os_type +contains + integer function get_os_type() result(r) + ! Determine the OS type + ! + ! Returns one of OS_LINUX, OS_MACOS, OS_WINDOWS. + ! + ! Currently we use the $HOME and $HOMEPATH environment variables to determine + ! the OS type. That is not 100% accurate in all cases, but it seems to be good + ! enough for now. See the following issue for a more robust solution: + ! + ! https://github.com/fortran-lang/fpm/issues/144 + ! + character(len=100) :: val + integer stat + ! Only Windows define $HOMEPATH by default and we test its value to improve the + ! chances of it working even if a user defines $HOMEPATH on Linux or macOS. + call get_environment_variable("HOMEPATH", val, status=stat) + if (stat == 0 .and. val(1:7) == "\Users\") then + r = OS_WINDOWS + return + end if + + ! We assume that $HOME=/home/... is Linux, $HOME=/Users/... is macOS, otherwise + ! we assume Linux. This is only a heuristic and can easily fail. + call get_environment_variable("HOME", val, status=stat) + if (stat == 1) then + print *, "$HOME does not exist" + error stop + end if + if (stat /= 0) then + print *, "get_environment_variable() failed" + error stop + end if + if (val(1:6) == "/home/") then + r = OS_LINUX + else if (val(1:7) == "/Users/") then + r = OS_MACOS + else + ! This will happen on HPC systems that typically do not use either /home nor + ! /Users for $HOME. Those systems are typically Linux, so for now we simply + ! set Linux here. + r = OS_LINUX + end if + end function +end module diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index aefbfd0..ed80313 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -1,11 +1,8 @@ module fpm +use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS implicit none private -public :: print_help, cmd_build, cmd_install, cmd_new, cmd_run, cmd_test - -integer, parameter :: OS_LINUX = 1 -integer, parameter :: OS_MACOS = 2 -integer, parameter :: OS_WINDOWS = 3 +public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test type string_t character(len=:), allocatable :: s @@ -13,50 +10,6 @@ end type contains -integer function get_os_type() result(r) -! Determine the OS type -! -! Returns one of OS_LINUX, OS_MACOS, OS_WINDOWS. -! -! Currently we use the $HOME and $HOMEPATH environment variables to determine -! the OS type. That is not 100% accurate in all cases, but it seems to be good -! enough for now. See the following issue for a more robust solution: -! -! https://github.com/fortran-lang/fpm/issues/144 -! -character(len=100) :: val -integer stat -! Only Windows define $HOMEPATH by default and we test its value to improve the -! chances of it working even if a user defines $HOMEPATH on Linux or macOS. -call get_environment_variable("HOMEPATH", val, status=stat) -if (stat == 0 .and. val(1:7) == "\Users\") then - r = OS_WINDOWS - return -end if - -! We assume that $HOME=/home/... is Linux, $HOME=/Users/... is macOS, otherwise -! we assume Linux. This is only a heuristic and can easily fail. -call get_environment_variable("HOME", val, status=stat) -if (stat == 1) then - print *, "$HOME does not exist" - error stop -end if -if (stat /= 0) then - print *, "get_environment_variable() failed" - error stop -end if -if (val(1:6) == "/home/") then - r = OS_LINUX -else if (val(1:7) == "/Users/") then - r = OS_MACOS -else - ! This will happen on HPC systems that typically do not use either /home nor - ! /Users for $HOME. Those systems are typically Linux, so for now we simply - ! set Linux here. - r = OS_LINUX -end if -end function - integer function number_of_rows(s) result(nrows) ! determine number or rows integer,intent(in)::s @@ -104,28 +57,6 @@ end do close(u) end subroutine -subroutine print_help() -print *, "fpm - A Fortran package manager and build system" -select case (get_os_type()) - case (OS_LINUX) - print *, "OS Type: Linux" - case (OS_MACOS) - print *, "OS Type: macOS" - case (OS_WINDOWS) - print *, "OS Type: Windows" -end select -print * -print *, "Usage:" -print *, " fpm [COMMAND]" -print * -print *, "Valid fpm commands are:" -print *, " build Compile the current package" -print *, " install Install a Fortran binary or library (not implemented)" -print *, " new Create a new Fortran package (not implemented)" -print *, " run Run a binary of the local package (not implemented)" -print *, " test Run the tests (not implemented)" -end subroutine - subroutine run(cmd) character(len=*), intent(in) :: cmd integer :: stat -- cgit v1.2.3