Add support for toggling Fortran features

awvwgk · awvwgk · commit 36e82f2425fb · 2023-04-02T11:37:40.000+02:00
diff --git a/ci/run_tests.sh b/ci/run_tests.sh
@@ -158,6 +158,14 @@ pushd cpp_files
 "$fpm" test
 popd
 
+# Test Fortran features
+for feature in free-format fixed-format implicit-typing implicit-external
+do
+  pushd $feature
+  "$fpm" run
+  popd
+done
+
 # Test app exit codes
 pushd fpm_test_exit_code
 "$fpm" build
diff --git a/example_packages/fixed-format/app/main.f90 b/example_packages/fixed-format/app/main.f90
@@ -0,0 +1,4 @@
+      program test
+      use lib
+      call hello
+      end
diff --git a/example_packages/fixed-format/fpm.toml b/example_packages/fixed-format/fpm.toml
@@ -0,0 +1,2 @@
+name = "fixed-format"
+fortran.source-format = "fixed"
diff --git a/example_packages/fixed-format/src/lib.f90 b/example_packages/fixed-format/src/lib.f90
@@ -0,0 +1,7 @@
+      module lib
+      contains
+      subroutine h e l l o
+      print '(a)',
+     +"Hello, fixed world!"
+      end subroutine
+      end module
diff --git a/example_packages/free-format/app/main.f b/example_packages/free-format/app/main.f
@@ -0,0 +1,4 @@
+program test
+use lib
+call hello
+end
diff --git a/example_packages/free-format/fpm.toml b/example_packages/free-format/fpm.toml
@@ -0,0 +1,3 @@
+name = "free-format"
+fortran.source-format = "free"
+executable = [{main="main.f", name="free-format"}]
diff --git a/example_packages/free-format/src/lib.f b/example_packages/free-format/src/lib.f
@@ -0,0 +1,6 @@
+module lib
+contains
+subroutine hello
+print '(a)', "Hello, free world!"
+end subroutine
+end module
diff --git a/example_packages/implicit-external/app/main.f90 b/example_packages/implicit-external/app/main.f90
@@ -0,0 +1,5 @@
+program test
+  integer :: ijk
+  call impl(ijk)
+  if (ijk /= 1) error stop
+end program test
diff --git a/example_packages/implicit-external/fpm.toml b/example_packages/implicit-external/fpm.toml
@@ -0,0 +1,2 @@
+name = "implicit-external"
+fortran.implicit-external = true
diff --git a/example_packages/implicit-external/src/impl.f90 b/example_packages/implicit-external/src/impl.f90
@@ -0,0 +1,4 @@
+subroutine impl(ijk)
+  integer :: ijk
+  ijk = 1
+end subroutine impl
diff --git a/example_packages/implicit-typing/app/main.f90 b/example_packages/implicit-typing/app/main.f90
@@ -0,0 +1,4 @@
+program test
+  use impl
+  if (ijk /= 1) error stop
+end program
diff --git a/example_packages/implicit-typing/fpm.toml b/example_packages/implicit-typing/fpm.toml
@@ -0,0 +1,2 @@
+name = "implicit-typing"
+fortran.implicit-typing = true
diff --git a/example_packages/implicit-typing/src/impl.f90 b/example_packages/implicit-typing/src/impl.f90
@@ -0,0 +1,3 @@
+module impl
+  parameter(ijk = 1)
+end module
diff --git a/src/fpm.f90 b/src/fpm.f90
@@ -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
@@ -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
 
diff --git a/src/fpm/manifest/fortran.f90 b/src/fpm/manifest/fortran.f90
@@ -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
diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90
@@ -27,6 +27,7 @@
 !>[profiles]
 !>[build]
 !>[install]
+!>[fortran]
 !>[[ executable ]]
 !>[[ example ]]
 !>[[ test ]]
@@ -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
@@ -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
 
@@ -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
@@ -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
diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90
@@ -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
@@ -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", &
@@ -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
@@ -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
diff --git a/src/fpm_model.f90 b/src/fpm_model.f90
diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90

-Original file line number
+Diff line change
@@ @@ -0,0 +1,4 @@ @@
 +      program test
 +      use lib
 +      call hello
 +      end
Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,2 @@`
	`1`	`+name = "fixed-format"`
	`2`	`+fortran.source-format = "fixed"`
Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+name = "free-format"`
	`2`	`+fortran.source-format = "free"`
	`3`	`+executable = [{main="main.f", name="free-format"}]`
Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,2 @@`
	`1`	`+name = "implicit-external"`
	`2`	`+fortran.implicit-external = true`