From f517a92096820052186f314821206aadd7b648b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 22 Jul 2020 12:05:02 -0600 Subject: Implement list_files() --- fpm/src/fpm.f90 | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index cc5666b..fc201e7 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -7,6 +7,10 @@ integer, parameter :: OS_LINUX = 1 integer, parameter :: OS_MACOS = 2 integer, parameter :: OS_WINDOWS = 3 +type string_t + character(len=:), allocatable :: s +end type + contains integer function get_os_type() result(r) @@ -53,6 +57,50 @@ else end if end function +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 +select case (get_os_type()) + case (OS_LINUX) + ! TODO: add `dir` into the `ls` command here: + call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) + case (OS_MACOS) + print *, "macOS not supported yet" + error stop + case (OS_WINDOWS) + print *, "Windows not supported yet" + error stop +end select +if (stat /= 0) then + print *, "execute_command_line() failed" +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 print_help() print *, "Fortran Package Manager (fpm)" select case (get_os_type()) @@ -83,7 +131,15 @@ end function subroutine cmd_build() logical :: src +type(string_t), allocatable :: files(:) +integer :: i print *, "# Building project" +call list_files("src", files) +print *, "Files in src/" +do i = 1, size(files) + print *, i, files(i)%s +end do +print * src = exists("src/fpm.f90") if (src) then call run("gfortran -c src/fpm.f90 -o fpm.o") -- cgit v1.2.3 From 7c552525051b6fa2bb6699595baffd3b429e25b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 22 Jul 2020 13:32:31 -0600 Subject: Implement str_ends_with() --- fpm/src/fpm.f90 | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index fc201e7..bffac56 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -129,6 +129,18 @@ 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 cmd_build() logical :: src type(string_t), allocatable :: files(:) -- cgit v1.2.3 From 2fee6474f00c4d589fc1f737519cd9965aa6b1ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 22 Jul 2020 13:33:02 -0600 Subject: Compile all the files in the src/ directory --- fpm/src/fpm.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index bffac56..9603717 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -144,19 +144,19 @@ end function subroutine cmd_build() logical :: src type(string_t), allocatable :: files(:) -integer :: i +character(:), allocatable :: basename +integer :: i, n print *, "# Building project" call list_files("src", files) -print *, "Files in src/" do i = 1, size(files) - print *, i, files(i)%s + if (str_ends_with(files(i)%s, ".f90")) then + n = len(files(i)%s) + basename = files(i)%s(1:n-4) + call run("gfortran -c src/" // basename // ".f90 -o " // basename // ".o") + end if end do -print * -src = exists("src/fpm.f90") -if (src) then - call run("gfortran -c src/fpm.f90 -o fpm.o") -end if call run("gfortran -c app/main.f90 -o main.o") +src = exists("src/fpm.f90") if (src) then call run("gfortran main.o fpm.o -o fpm") else -- cgit v1.2.3 From 6445315b1e473afefdfe79fef4adc304c2e69153 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 22 Jul 2020 13:38:37 -0600 Subject: Implement package_name() --- fpm/src/fpm.f90 | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 9603717..c1bf54a 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -141,10 +141,20 @@ else end if end function +subroutine package_name(name) +character(:), allocatable, intent(out) :: name +! Currrently a heuristic. We should update this to read the name from fpm.toml +if (exists("src/fpm.f90")) then + name = "fpm" +else + name = "hello_world" +end if +end subroutine + subroutine cmd_build() logical :: src type(string_t), allocatable :: files(:) -character(:), allocatable :: basename +character(:), allocatable :: basename, pkg_name integer :: i, n print *, "# Building project" call list_files("src", files) @@ -156,6 +166,7 @@ do i = 1, size(files) end if end do call run("gfortran -c app/main.f90 -o main.o") +call package_name(pkg_name) src = exists("src/fpm.f90") if (src) then call run("gfortran main.o fpm.o -o fpm") -- cgit v1.2.3 From 9a12ab0f29cabcdcf509d412d13ddd62c9455e47 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 22 Jul 2020 13:40:58 -0600 Subject: Use pkg_name --- fpm/src/fpm.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index c1bf54a..fb5e824 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -169,9 +169,9 @@ call run("gfortran -c app/main.f90 -o main.o") call package_name(pkg_name) src = exists("src/fpm.f90") if (src) then - call run("gfortran main.o fpm.o -o fpm") + call run("gfortran main.o fpm.o -o " // pkg_name) else - call run("gfortran main.o -o hello_world") + call run("gfortran main.o -o " // pkg_name) end if end subroutine -- cgit v1.2.3 From 46a607ad8d74cd021772e900a93b73f9ac9368e1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 22 Jul 2020 13:49:24 -0600 Subject: Use more automatic building --- fpm/src/fpm.f90 | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index fb5e824..aabcfd1 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -152,27 +152,23 @@ end if end subroutine subroutine cmd_build() -logical :: src type(string_t), allocatable :: files(:) -character(:), allocatable :: basename, pkg_name +character(:), allocatable :: basename, pkg_name, linking integer :: i, n print *, "# Building project" call list_files("src", files) +linking = "" do i = 1, size(files) if (str_ends_with(files(i)%s, ".f90")) then n = len(files(i)%s) basename = files(i)%s(1:n-4) call run("gfortran -c src/" // basename // ".f90 -o " // basename // ".o") + linking = linking // " " // basename // ".o" end if end do call run("gfortran -c app/main.f90 -o main.o") call package_name(pkg_name) -src = exists("src/fpm.f90") -if (src) then - call run("gfortran main.o fpm.o -o " // pkg_name) -else - call run("gfortran main.o -o " // pkg_name) -end if +call run("gfortran main.o " // linking // " -o " // pkg_name) end subroutine end module fpm -- cgit v1.2.3 From 7d168038cc4108f97b6347000ffdd9749a12f65a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 22 Jul 2020 13:55:06 -0600 Subject: Add error stop --- fpm/src/fpm.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index aabcfd1..846082f 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -91,6 +91,7 @@ select case (get_os_type()) 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))) -- cgit v1.2.3 From fc03a11ebd76a089fc5191ac0fa064e87b17d0ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 22 Jul 2020 14:01:02 -0600 Subject: Recover from `src/` not existing --- fpm/src/fpm.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 846082f..bf99641 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -90,8 +90,10 @@ select case (get_os_type()) error stop end select if (stat /= 0) then - print *, "execute_command_line() failed" - error stop + print *, "execute_command_line() failed, but continuing" + ! Not erroring out here, as sometimes the `dir` might not exist + allocate(files(0)) + return end if open(newunit=u, file="fpm_ls.out", status="old") allocate(files(number_of_rows(u))) -- cgit v1.2.3 From c82579b3e245e91ddec40815c059c7b432d5ee6a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 22 Jul 2020 14:23:54 -0600 Subject: Add a check for directory --- fpm/src/fpm.f90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index bf99641..45d8782 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -78,9 +78,13 @@ 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) - ! TODO: add `dir` into the `ls` command here: call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) case (OS_MACOS) print *, "macOS not supported yet" @@ -90,10 +94,8 @@ select case (get_os_type()) error stop end select if (stat /= 0) then - print *, "execute_command_line() failed, but continuing" - ! Not erroring out here, as sometimes the `dir` might not exist - allocate(files(0)) - return + print *, "execute_command_line() failed" + error stop end if open(newunit=u, file="fpm_ls.out", status="old") allocate(files(number_of_rows(u))) -- cgit v1.2.3 From 0a978d6b694e90d2a218d6e1dc210a427a6a865c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 22 Jul 2020 14:24:15 -0600 Subject: Get macOS working --- fpm/src/fpm.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index 45d8782..eb30741 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -87,8 +87,7 @@ select case (get_os_type()) case (OS_LINUX) call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) case (OS_MACOS) - print *, "macOS not supported yet" - error stop + call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) case (OS_WINDOWS) print *, "Windows not supported yet" error stop -- cgit v1.2.3 From 2cf6e82775f45241e658bbcb098175033e58b6ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C4=8Cert=C3=ADk?= Date: Wed, 22 Jul 2020 14:27:07 -0600 Subject: Try to get Windows working --- fpm/src/fpm.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/fpm/src/fpm.f90 b/fpm/src/fpm.f90 index eb30741..bd1a70e 100644 --- a/fpm/src/fpm.f90 +++ b/fpm/src/fpm.f90 @@ -89,8 +89,7 @@ select case (get_os_type()) case (OS_MACOS) call execute_command_line("ls " // dir // " > fpm_ls.out", exitstat=stat) case (OS_WINDOWS) - print *, "Windows not supported yet" - error stop + call execute_command_line("dir /b " // dir // " > fpm_ls.out", exitstat=stat) end select if (stat /= 0) then print *, "execute_command_line() failed" -- cgit v1.2.3