Skip to content

Commit

Permalink
Add support for toggling Fortran features
Browse files Browse the repository at this point in the history
  • Loading branch information
awvwgk committed Apr 2, 2023
1 parent 55d94b0 commit 29af5a0
Show file tree
Hide file tree
Showing 19 changed files with 307 additions and 8 deletions.
7 changes: 7 additions & 0 deletions ci/run_tests.sh
Original file line number Diff line number Diff line change
Expand Up @@ -162,6 +162,13 @@ popd
pushd fpm_test_exit_code
"$fpm" build

for feature in free_format fixed_format implicit_typing implicit_external
do
pushd $feature
"$fpm" run
popd
done

# odd number -> success!
EXIT_CODE=0
"$fpm" run -- 1 || EXIT_CODE=$?
Expand Down
4 changes: 4 additions & 0 deletions example_packages/fixed_format/app/main.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
program test
use lib
call hello
end
2 changes: 2 additions & 0 deletions example_packages/fixed_format/fpm.toml
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
name = "fixed-format"
fortran.source-format = "fixed"
7 changes: 7 additions & 0 deletions example_packages/fixed_format/src/lib.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
module lib
contains
subroutine h e l l o
print '(a)',
+"Hello, fixed world!"
end subroutine
end module
4 changes: 4 additions & 0 deletions example_packages/free_format/app/main.f
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
program test
use lib
call hello
end
3 changes: 3 additions & 0 deletions example_packages/free_format/fpm.toml
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
name = "free-format"
fortran.source-format = "free"
executable = [{main="main.f", name="free-format"}]
6 changes: 6 additions & 0 deletions example_packages/free_format/src/lib.f
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
module lib
contains
subroutine hello
print '(a)', "Hello, free world!"
end subroutine
end module
5 changes: 5 additions & 0 deletions example_packages/implicit-external/app/main.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
program test
integer :: ijk
call impl(ijk)
if (ijk /= 1) error stop
end program test
2 changes: 2 additions & 0 deletions example_packages/implicit-external/fpm.toml
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
name = "implicit-external"
fortran.implicit-external = false
4 changes: 4 additions & 0 deletions example_packages/implicit-external/src/impl.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
subroutine impl(ijk)
integer :: ijk
ijk = 1
end subroutine impl
4 changes: 4 additions & 0 deletions example_packages/implicit-typing/app/main.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
program test
use impl
if (ijk /= 1) error stop
end program
2 changes: 2 additions & 0 deletions example_packages/implicit-typing/fpm.toml
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
name = "implicit-typing"
fortran.implicit-typing = true
3 changes: 3 additions & 0 deletions example_packages/implicit-typing/src/impl.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
module impl
parameter(ijk = 1)
end module
7 changes: 6 additions & 1 deletion src/fpm.f90
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ module fpm
use fpm_environment, only: get_env
use fpm_filesystem, only: is_dir, join_path, list_files, exists, &
basename, filewrite, mkdir, run, os_delete_dir
use fpm_model, only: fpm_model_t, srcfile_t, show_model, &
use fpm_model, only: fpm_model_t, srcfile_t, show_model, fortran_features_t, &
FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, &
FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST
use fpm_compiler, only: new_compiler, new_archiver, set_cpp_preprocessor_flags
Expand Down Expand Up @@ -112,6 +112,11 @@ subroutine build_model(model, settings, package, error)
if (allocated(error)) exit

model%packages(i)%name = dependency%name
associate(features => model%packages(i)%features)
features%implicit_typing = dependency%fortran%implicit_typing
features%implicit_external = dependency%fortran%implicit_external
features%source_format = dependency%fortran%source_format
end associate
call package%version%to_string(version)
model%packages(i)%version = version

Expand Down
105 changes: 105 additions & 0 deletions src/fpm/manifest/fortran.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,105 @@
module fpm_manifest_fortran
use fpm_error, only : error_t, syntax_error, fatal_error
use fpm_toml, only : toml_table, toml_key, toml_stat, get_value
implicit none
private

public :: fortran_config_t, new_fortran_config

!> Configuration data for Fortran
type :: fortran_config_t

!> Enable default implicit typing
logical :: implicit_typing

!> Enable implicit external interfaces
logical :: implicit_external

!> Use free format for all Fortran sources
character(:), allocatable :: source_format

end type fortran_config_t

contains

!> Construct a new build configuration from a TOML data structure
subroutine new_fortran_config(self, table, error)

!> Instance of the fortran configuration
type(fortran_config_t), intent(out) :: self

!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table

!> Error handling
type(error_t), allocatable, intent(out) :: error

integer :: stat
character(:), allocatable :: source_format

call check(table, error)
if (allocated(error)) return

call get_value(table, "implicit-typing", self%implicit_typing, .false., stat=stat)

if (stat /= toml_stat%success) then
call fatal_error(error,"Error while reading value for 'implicit-typing' in fpm.toml, expecting logical")
return
end if

call get_value(table, "implicit-external", self%implicit_external, .false., stat=stat)

if (stat /= toml_stat%success) then
call fatal_error(error,"Error while reading value for 'implicit-external' in fpm.toml, expecting logical")
return
end if

call get_value(table, "source-format", source_format, "free", stat=stat)

if (stat /= toml_stat%success) then
call fatal_error(error,"Error while reading value for 'source-format' in fpm.toml, expecting logical")
return
end if
select case(source_format)
case default
call fatal_error(error,"Value of source-format cannot be '"//source_format//"'")
return
case("free", "fixed", "default")
self%source_format = source_format
end select

end subroutine new_fortran_config

!> Check local schema for allowed entries
subroutine check(table, error)

!> Instance of the TOML data structure
type(toml_table), intent(inout) :: table

!> Error handling
type(error_t), allocatable, intent(out) :: error

type(toml_key), allocatable :: list(:)
integer :: ikey

call table%get_keys(list)

! table can be empty
if (size(list) < 1) return

do ikey = 1, size(list)
select case(list(ikey)%key)

case("implicit-typing", "implicit-external", "source-format")
continue

case default
call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in fortran")
exit

end select
end do

end subroutine check

end module fpm_manifest_fortran
15 changes: 14 additions & 1 deletion src/fpm/manifest/package.f90
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@
!>[profiles]
!>[build]
!>[install]
!>[fortran]
!>[[ executable ]]
!>[[ example ]]
!>[[ test ]]
Expand All @@ -38,6 +39,7 @@ module fpm_manifest_package
use fpm_manifest_profile, only : profile_config_t, new_profiles, get_default_profiles
use fpm_manifest_example, only : example_config_t, new_example
use fpm_manifest_executable, only : executable_config_t, new_executable
use fpm_manifest_fortran, only : fortran_config_t, new_fortran_config
use fpm_manifest_library, only : library_config_t, new_library
use fpm_manifest_install, only: install_config_t, new_install_config
use fpm_manifest_test, only : test_config_t, new_test
Expand Down Expand Up @@ -75,6 +77,9 @@ module fpm_manifest_package
!> Installation configuration data
type(install_config_t) :: install

!> Fortran meta data
type(fortran_config_t) :: fortran

!> Library meta data
type(library_config_t), allocatable :: library

Expand Down Expand Up @@ -173,6 +178,14 @@ subroutine new_package(self, table, root, error)
call new_install_config(self%install, child, error)
if (allocated(error)) return

call get_value(table, "fortran", child, requested=.true., stat=stat)
if (stat /= toml_stat%success) then
call fatal_error(error, "Type mismatch for fortran entry, must be a table")
return
end if
call new_fortran_config(self%fortran, child, error)
if (allocated(error)) return

call get_value(table, "version", version, "0")
call new_version(self%version, version, error)
if (allocated(error) .and. present(root)) then
Expand Down Expand Up @@ -328,7 +341,7 @@ subroutine check(table, error)
case("version", "license", "author", "maintainer", "copyright", &
& "description", "keywords", "categories", "homepage", "build", &
& "dependencies", "dev-dependencies", "profiles", "test", "executable", &
& "example", "library", "install", "extra", "preprocess")
& "example", "library", "install", "extra", "preprocess", "fortran")
continue

end select
Expand Down
76 changes: 73 additions & 3 deletions src/fpm_compiler.F90
Original file line number Diff line number Diff line change
Expand Up @@ -94,6 +94,8 @@ module fpm_compiler
procedure :: get_module_flag
!> Get flag for include directories
procedure :: get_include_flag
!> Get feature flag
procedure :: get_feature_flag
!> Compile a Fortran object
procedure :: compile_fortran
!> Compile a C object
Expand Down Expand Up @@ -137,10 +139,14 @@ module fpm_compiler
flag_gnu_opt = " -O3 -funroll-loops", &
flag_gnu_debug = " -g", &
flag_gnu_pic = " -fPIC", &
flag_gnu_warn = " -Wall -Wextra -Wimplicit-interface", &
flag_gnu_warn = " -Wall -Wextra", &
flag_gnu_check = " -fcheck=bounds -fcheck=array-temps", &
flag_gnu_limit = " -fmax-errors=1", &
flag_gnu_external = " -Wimplicit-interface"
flag_gnu_external = " -Wimplicit-interface", &
flag_gnu_no_implicit_typing = " -fimplicit-none", &
flag_gnu_no_implicit_external = " -Werror=implicit-interface", &
flag_gnu_free_format = " -ffree-form", &
flag_gnu_fixed_format = " -ffixed-form"

character(*), parameter :: &
flag_pgi_backslash = " -Mbackslash", &
Expand Down Expand Up @@ -185,7 +191,10 @@ module fpm_compiler
flag_nag_backtrace = " -gline"

character(*), parameter :: &
flag_lfortran_opt = " --fast"
flag_lfortran_opt = " --fast", &
flag_lfortran_implicit_typing = " --implicit-typing", &
flag_lfortran_implicit_external = " --allow-implicit-interface", &
flag_lfortran_fixed_format = " --fixed-form"


contains
Expand Down Expand Up @@ -539,6 +548,67 @@ function get_module_flag(self, path) result(flags)
end function get_module_flag


function get_feature_flag(self, feature) result(flags)
class(compiler_t), intent(in) :: self
character(len=*), intent(in) :: feature
character(len=:), allocatable :: flags

flags = ""
select case(feature)
case("no-implicit-typing")
select case(self%id)
case(id_caf, id_gcc, id_f95)
flags = flag_gnu_no_implicit_typing

end select

case("implicit-typing")
select case(self%id)
case(id_lfortran)
flags = flag_lfortran_implicit_typing

end select

case("no-implicit-external")
select case(self%id)
case(id_caf, id_gcc, id_f95)
flags = flag_gnu_no_implicit_external

end select

case("implicit-external")
select case(self%id)
case(id_lfortran)
flags = flag_lfortran_implicit_external

end select

case("free-format")
select case(self%id)
case(id_caf, id_gcc, id_f95)
flags = flag_gnu_free_format

end select

case("fixed-format")
select case(self%id)
case(id_caf, id_gcc, id_f95)
flags = flag_gnu_fixed_format

case(id_lfortran)
flags = flag_lfortran_fixed_format

end select

case("default-format")
continue

case default
error stop "Unknown feature '"//feature//"'"
end select
end function get_feature_flag


subroutine get_default_c_compiler(f_compiler, c_compiler)
character(len=*), intent(in) :: f_compiler
character(len=:), allocatable, intent(out) :: c_compiler
Expand Down
Loading

0 comments on commit 29af5a0

Please sign in to comment.