Merge pull request #157 from awvwgk/fortran-impl

Implement reading of fpm.toml

Author: milancurcic

ci/run_tests.bat

@@ -9,6 +9,9 @@ if errorlevel 1 exit 1
 fpm run
 if errorlevel 1 exit 1
 
+fpm test
+if errorlevel 1 exit 1
+
 build\gfortran_debug\app\fpm
 if errorlevel 1 exit 1
 

ci/run_tests.sh

@@ -5,6 +5,7 @@ set -ex
 cd fpm
 fpm build
 fpm run
+fpm test
 build/gfortran_debug/app/fpm
 cd ../test/example_packages/hello_world
 ../../../fpm/build/gfortran_debug/app/fpm build

fpm/fpm.toml

@@ -4,3 +4,13 @@ license = "MIT"
 author = "fpm maintainers"
 maintainer = ""
 copyright = "2020 fpm contributors"
+
+[dependencies]
+[dependencies.toml-f]
+git = "https://github.com/toml-f/toml-f"
+rev = "290ba87671ab593e7bd51599e1d80ea736b3cd36"
+
+[[test]]
+name = "fpm-test"
+source-dir = "test"
+main = "main.f90"

fpm/src/fpm.f90

@@ -1,5 +1,8 @@
 module fpm
 use environment, only: get_os_type, OS_LINUX, OS_MACOS, OS_WINDOWS
+use fpm_manifest, only : get_package_data, default_executable, default_library, &
+    & package_t
+use fpm_error, only : error_t
 implicit none
 private
 public :: cmd_build, cmd_install, cmd_new, cmd_run, cmd_test
@@ -85,34 +88,55 @@ logical function str_ends_with(s, e) result(r)
 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()
+type(package_t) :: package
+type(error_t), allocatable :: error
 type(string_t), allocatable :: files(:)
-character(:), allocatable :: basename, pkg_name, linking
+character(:), allocatable :: basename, linking
 integer :: i, n
-print *, "# Building project"
-call list_files("src", files)
+call get_package_data(package, "fpm.toml", error)
+if (allocated(error)) then
+    print '(a)', error%message
+    error stop 1
+end if
+
+! Populate library in case we find the default src directory
+if (.not.allocated(package%library) .and. exists("src")) then
+    call default_library(package%library)
+end if
+
+! Populate executable in case we find the default app directory
+if (.not.allocated(package%executable) .and. exists("app")) then
+    allocate(package%executable(1))
+    call default_executable(package%executable(1), package%name)
+end if
+
+if (.not.(allocated(package%library) .or. allocated(package%executable))) then
+    print '(a)', "Neither library nor executable found, there is nothing to do"
+    error stop 1
+end if
+
 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
+if (allocated(package%library)) then
+    call list_files(package%library%source_dir, files)
+    do i = 1, size(files)
+        if (str_ends_with(files(i)%s, ".f90")) then
+            n = len(files(i)%s)
+            basename = files(i)%s
+            call run("gfortran -c " // package%library%source_dir // "/" // &
+               & basename // " -o " // basename // ".o")
+            linking = linking // " " // basename // ".o"
+        end if
+    end do
+end if
+
+do i = 1, size(package%executable)
+    basename = package%executable(i)%main
+    call run("gfortran -c " // package%executable(i)%source_dir // "/" // &
+       & basename // " -o " // basename // ".o")
+    call run("gfortran " // basename // ".o " // linking // " -o " // &
+       & package%executable(i)%name)
 end do
-call run("gfortran -c app/main.f90 -o main.o")
-call package_name(pkg_name)
-call run("gfortran main.o " // linking // " -o " // pkg_name)
 end subroutine
 
 subroutine cmd_install()

fpm/src/fpm/error.f90

@@ -0,0 +1,58 @@
+!> Implementation of basic error handling.
+module fpm_error
+    implicit none
+    private
+
+    public :: error_t
+    public :: fatal_error, syntax_error, file_not_found_error
+
+
+    !> Data type defining an error
+    type :: error_t
+
+        !> Error message
+        character(len=:), allocatable :: message
+
+    end type error_t
+
+
+    !> Alias syntax errors to fatal errors for now
+    interface syntax_error
+        module procedure :: fatal_error
+    end interface syntax_error
+
+
+contains
+
+
+    !> Generic fatal runtime error
+    subroutine fatal_error(error, message)
+
+        !> Instance of the error data
+        type(error_t), allocatable, intent(out) :: error
+
+        !> Error message
+        character(len=*), intent(in) :: message
+
+        allocate(error)
+        error%message = message
+
+    end subroutine fatal_error
+
+
+    !> Error created when a file is missing or not found
+    subroutine file_not_found_error(error, file_name)
+
+        !> Instance of the error data
+        type(error_t), allocatable, intent(out) :: error
+
+        !> Name of the missing file
+        character(len=*), intent(in) :: file_name
+
+        allocate(error)
+        error%message = "'"//file_name//"' could not be found, check if the file exists"
+
+    end subroutine file_not_found_error
+
+
+end module fpm_error

fpm/src/fpm/git.f90

@@ -0,0 +1,170 @@
+!> Implementation for interacting with git repositories.
+module fpm_git
+    implicit none
+
+    public :: git_target_t
+    public :: git_target_default, git_target_branch, git_target_tag, &
+        & git_target_revision
+
+
+    !> Possible git target
+    type :: enum_descriptor
+
+        !> Default target
+        integer :: default = 200
+
+        !> Branch in git repository
+        integer :: branch = 201
+
+        !> Tag in git repository
+        integer :: tag = 202
+
+        !> Commit hash
+        integer :: revision = 203
+
+    end type enum_descriptor
+
+    !> Actual enumerator for descriptors
+    type(enum_descriptor), parameter :: git_descriptor = enum_descriptor()
+
+
+    !> Description of an git target
+    type :: git_target_t
+        private
+
+        !> Kind of the git target
+        integer :: descriptor = git_descriptor%default
+
+        !> Target URL of the git repository
+        character(len=:), allocatable :: url
+
+        !> Additional descriptor of the git object
+        character(len=:), allocatable :: object
+
+    contains
+
+        !> Show information on instance
+        procedure :: info
+
+    end type git_target_t
+
+
+contains
+
+
+    !> Default target
+    function git_target_default(url) result(self)
+
+        !> Target URL of the git repository
+        character(len=*), intent(in) :: url
+
+        !> New git target
+        type(git_target_t) :: self
+
+        self%descriptor = git_descriptor%default
+        self%url = url
+
+    end function git_target_default
+
+
+    !> Target a branch in the git repository
+    function git_target_branch(url, branch) result(self)
+
+        !> Target URL of the git repository
+        character(len=*), intent(in) :: url
+
+        !> Name of the branch of interest
+        character(len=*), intent(in) :: branch
+
+        !> New git target
+        type(git_target_t) :: self
+
+        self%descriptor = git_descriptor%branch
+        self%url = url
+        self%object = branch
+
+    end function git_target_branch
+
+
+    !> Target a specific git revision
+    function git_target_revision(url, sha1) result(self)
+
+        !> Target URL of the git repository
+        character(len=*), intent(in) :: url
+
+        !> Commit hash of interest
+        character(len=*), intent(in) :: sha1
+
+        !> New git target
+        type(git_target_t) :: self
+
+        self%descriptor = git_descriptor%revision
+        self%url = url
+        self%object = sha1
+
+    end function git_target_revision
+
+
+    !> Target a git tag
+    function git_target_tag(url, tag) result(self)
+
+        !> Target URL of the git repository
+        character(len=*), intent(in) :: url
+
+        !> Tag name of interest
+        character(len=*), intent(in) :: tag
+
+        !> New git target
+        type(git_target_t) :: self
+
+        self%descriptor = git_descriptor%tag
+        self%url = url
+        self%object = tag
+
+    end function git_target_tag
+
+
+    !> Show information on git target
+    subroutine info(self, unit, verbosity)
+
+        !> Instance of the git target
+        class(git_target_t), intent(in) :: self
+
+        !> Unit for IO
+        integer, intent(in) :: unit
+
+        !> Verbosity of the printout
+        integer, intent(in), optional :: verbosity
+
+        integer :: pr
+        character(len=*), parameter :: fmt = '("#", 1x, a, t30, a)'
+
+        if (present(verbosity)) then
+            pr = verbosity
+        else
+            pr = 1
+        end if
+
+        if (pr < 1) return
+
+        write(unit, fmt) "Git target"
+        if (allocated(self%url)) then
+            write(unit, fmt) "- URL", self%url
+        end if
+        if (allocated(self%object)) then
+            select case(self%descriptor)
+            case default
+                write(unit, fmt) "- object", self%object
+            case(git_descriptor%tag)
+                write(unit, fmt) "- tag", self%object
+            case(git_descriptor%branch)
+                write(unit, fmt) "- branch", self%object
+            case(git_descriptor%revision)
+                write(unit, fmt) "- sha1", self%object
+            end select
+        end if
+
+    end subroutine info
+
+
+end module fpm_git