feat: added basic preprocess table configuration (#715)

* feat: added basic preprocess table configuration

* refactor: added new_preprocessors subroutine

* feat: added example for preprocess_cpp

* feat: added minimal program in example for testing

* fix: documentation in preprocess file

* fix: Empty preprocess table should not be allowed

* feat: ability to set cpp flag if preprocess.cpp is found in manifest

* fix: comment message

* test: added tests for preprocess table

* docs: small grammatical changes

* fix: added the option to modify cpp preprocessor flag

* refactor: added pr usage

* refactor: added checks for windows intel fortron compiler for cpp flag

Author: arteevraina

example_packages/preprocess_cpp/.gitignore

@@ -0,0 +1 @@
+build/*

example_packages/preprocess_cpp/fpm.toml

@@ -0,0 +1,4 @@
+name = "preprocess_cpp"
+
+[preprocess]
+[preprocess.cpp]

example_packages/preprocess_cpp/src/preprocess_cpp.f90

@@ -0,0 +1,13 @@
+module preprocess_cpp
+   implicit none
+   private
+
+   public :: say_hello
+contains
+   subroutine say_hello
+      print *, "Hello, preprocess_cpp!"
+#ifndef TESTMACRO
+      This breaks the build.
+#endif
+   end subroutine say_hello
+end module preprocess_cpp

src/fpm.f90

@@ -12,7 +12,7 @@ module fpm
 use fpm_model, only: fpm_model_t, srcfile_t, show_model, &
                     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
+use fpm_compiler, only: new_compiler, new_archiver, set_preprocessor_flags
 
 
 use fpm_sources, only: add_executable_sources, add_sources_from_dir
@@ -77,6 +77,9 @@ subroutine build_model(model, settings, package, error)
             flags = flags // model%compiler%get_default_flags(settings%profile == "release")
         end select
     end if
+
+    call set_preprocessor_flags(model%compiler%id, flags)
+
     cflags = trim(settings%cflag)
     ldflags = trim(settings%ldflag)
 

src/fpm/manifest.f90

@@ -12,6 +12,7 @@ module fpm_manifest
     use fpm_manifest_executable, only : executable_config_t
     use fpm_manifest_dependency, only : dependency_config_t
     use fpm_manifest_library, only : library_config_t
+    use fpm_mainfest_preprocess, only : preprocess_config_t
     use fpm_manifest_package, only : package_config_t, new_package
     use fpm_error, only : error_t, fatal_error, file_not_found_error
     use fpm_toml, only : toml_table, read_package_file
@@ -23,7 +24,7 @@ module fpm_manifest
 
     public :: get_package_data, default_executable, default_library, default_test
     public :: default_example
-    public :: package_config_t, dependency_config_t
+    public :: package_config_t, dependency_config_t, preprocess_config_t
 
 
 contains

src/fpm/manifest/package.f90

@@ -39,6 +39,7 @@ module fpm_manifest_package
     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
+    use fpm_mainfest_preprocess, only : preprocess_config_t, new_preprocessors
     use fpm_filesystem, only : exists, getline, join_path
     use fpm_error, only : error_t, fatal_error, syntax_error, bad_name_error
     use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, &
@@ -89,6 +90,9 @@ module fpm_manifest_package
         !> Test meta data
         type(test_config_t), allocatable :: test(:)
 
+        !> Preprocess meta data
+        type(preprocess_config_t), allocatable :: preprocess(:)
+
     contains
 
         !> Print information on this instance
@@ -267,6 +271,11 @@ subroutine new_package(self, table, root, error)
             if (allocated(error)) return
         end if
 
+        call get_value(table, "preprocess", child, requested=.false.)
+        if (associated(child)) then
+            call new_preprocessors(self%preprocess, child, error)
+            if (allocated(error)) return
+        end if
     end subroutine new_package
 
 
@@ -304,7 +313,7 @@ subroutine check(table, error)
             case("version", "license", "author", "maintainer", "copyright", &
                     & "description", "keywords", "categories", "homepage", "build", &
                     & "dependencies", "dev-dependencies", "test", "executable", &
-                    & "example", "library", "install", "extra")
+                    & "example", "library", "install", "extra", "preprocess")
                 continue
 
             end select

src/fpm/manifest/preprocess.f90

@@ -0,0 +1,194 @@
+!> Implementation of the meta data for preprocessing.
+!>
+!> A preprocess table can currently have the following fields
+!>
+!> ```toml
+!> [preprocess]
+!> [preprocess.cpp]
+!> suffixes = ["F90", "f90"]
+!> directories = ["src/feature1", "src/models"]
+!> macros = []
+!> ```
+
+module fpm_mainfest_preprocess
+   use fpm_error, only : error_t, syntax_error
+   use fpm_strings, only : string_t
+   use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list
+   implicit none
+   private
+
+   public :: preprocess_config_t, new_preprocess_config, new_preprocessors
+
+   !> Configuration meta data for a preprocessor
+   type :: preprocess_config_t
+
+      !> Name of the preprocessor
+      character(len=:), allocatable :: name
+
+      !> Suffixes of the files to be preprocessed
+      type(string_t), allocatable :: suffixes(:)
+
+      !> Directories to search for files to be preprocessed
+      type(string_t), allocatable :: directories(:)
+
+      !> Macros to be defined for the preprocessor
+      type(string_t), allocatable :: macros(:)
+
+   contains
+
+      !> Print information on this instance
+      procedure :: info
+
+   end type preprocess_config_t
+
+contains
+
+   !> Construct a new preprocess configuration from TOML data structure
+   subroutine new_preprocess_config(self, table, error)
+
+      !> Instance of the preprocess configuration
+      type(preprocess_config_t), intent(out) :: self
+
+      !> Instance of the TOML data structure.
+      type(toml_table), intent(inout) :: table
+
+      !> Error handling
+      type(error_t), allocatable, intent(inout) :: error
+
+      call check(table, error)
+      if (allocated(error)) return
+
+      call table%get_key(self%name)
+
+      call get_list(table, "suffixes", self%suffixes, error)
+      if (allocated(error)) return
+
+      call get_list(table, "directories", self%directories, error)
+      if (allocated(error)) return
+
+      call get_list(table, "macros", self%macros, error)
+      if (allocated(error)) return
+
+   end subroutine new_preprocess_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(inout) :: error
+
+      character(len=:), allocatable :: name
+      type(toml_key), allocatable :: list(:)
+      logical :: suffixes_present, directories_present, macros_present
+      integer :: ikey
+
+      suffixes_present = .false.
+      directories_present = .false.
+      macros_present = .false.
+
+      call table%get_key(name)
+      call table%get_keys(list)
+
+      do ikey = 1, size(list)
+         select case(list(ikey)%key)
+          case default
+            call syntax_error(error, "Key " // list(ikey)%key // "is not allowed in preprocessor"//name)
+            exit
+          case("suffixes")
+            suffixes_present = .true.
+          case("directories")
+            directories_present = .true.
+          case("macros")
+            macros_present = .true.
+         end select
+      end do
+   end subroutine check
+
+   !> Construct new preprocess array from a TOML data structure.
+   subroutine new_preprocessors(preprocessors, table, error)
+
+      !> Instance of the preprocess configuration
+      type(preprocess_config_t), allocatable, intent(out) :: preprocessors(:)
+
+      !> Instance of the TOML data structure
+      type(toml_table), intent(inout) :: table
+
+      !> Error handling
+      type(error_t), allocatable, intent(out) :: error
+
+      type(toml_table), pointer :: node
+      type(toml_key), allocatable :: list(:)
+      integer :: iprep, stat
+
+      call table%get_keys(list)
+
+      ! An empty table is not allowed
+      if (size(list) == 0) then
+         call syntax_error(error, "No preprocessors defined")
+      end if
+
+      allocate(preprocessors(size(list)))
+      do iprep = 1, size(list)
+         call get_value(table, list(iprep)%key, node, stat=stat)
+         if (stat /= toml_stat%success) then
+            call syntax_error(error, "Preprocessor "//list(iprep)%key//" must be a table entry")
+            exit
+         end if
+         call new_preprocess_config(preprocessors(iprep), node, error)
+         if (allocated(error)) exit
+      end do
+
+   end subroutine new_preprocessors
+
+   !> Write information on this instance
+   subroutine info(self, unit, verbosity)
+
+      !> Instance of the preprocess configuration
+      class(preprocess_config_t), intent(in) :: self
+
+      !> Unit for IO
+      integer, intent(in) :: unit
+
+      !> Verbosity of the printout
+      integer, intent(in), optional :: verbosity
+
+      integer :: pr, ilink
+      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) "Preprocessor"
+      if (allocated(self%name)) then
+         write(unit, fmt) "- name", self%name
+      end if
+      if (allocated(self%suffixes)) then
+         write(unit, fmt) " - suffixes"
+         do ilink = 1, size(self%suffixes)
+            write(unit, fmt) "   - " // self%suffixes(ilink)%s
+         end do
+      end if
+      if (allocated(self%directories)) then
+         write(unit, fmt) " - directories"
+         do ilink = 1, size(self%directories)
+            write(unit, fmt) "   - " // self%directories(ilink)%s
+         end do
+      end if
+      if (allocated(self%macros)) then
+         write(unit, fmt) " - macros"
+         do ilink = 1, size(self%macros)
+            write(unit, fmt) "   - " // self%macros(ilink)%s
+         end do
+      end if
+
+   end subroutine info
+
+end module fpm_mainfest_preprocess

src/fpm_compiler.f90

@@ -40,6 +40,8 @@ module fpm_compiler
 use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path, &
     & getline, run
 use fpm_strings, only: split, string_cat, string_t
+use fpm_manifest, only : get_package_data, package_config_t
+use fpm_error, only: error_t
 implicit none
 public :: compiler_t, new_compiler, archiver_t, new_archiver
 public :: debug
@@ -177,6 +179,7 @@ module fpm_compiler
 character(*), parameter :: &
     flag_lfortran_opt = " --fast"
 
+    
 contains
 
 
@@ -376,6 +379,49 @@ subroutine get_debug_compile_flags(id, flags)
     end select
 end subroutine get_debug_compile_flags
 
+subroutine set_preprocessor_flags (id, flags)
+    integer(compiler_enum), intent(in) :: id
+    type(package_config_t) :: package
+    type(error_t), allocatable :: error
+    character(len=:), allocatable :: flags
+    character(len=:), allocatable :: flag_cpp_preprocessor
+    
+    integer :: i
+
+    call get_package_data(package, "fpm.toml", error)
+
+    if (allocated(error)) then 
+       return
+    end if
+    
+    !> Check if there is a preprocess table
+    if (.not.allocated(package%preprocess)) then
+        return
+    end if
+
+    !> Modify the flag_cpp_preprocessor on the basis of the compiler.
+    select case(id)
+    case default
+        flag_cpp_preprocessor = ""
+    case(id_caf, id_gcc, id_f95, id_nvhpc)
+        flag_cpp_preprocessor = "-cpp"
+    case(id_intel_classic_windows, id_intel_llvm_windows)
+        flag_cpp_preprocessor = "/fpp"
+    case(id_intel_classic_nix, id_intel_classic_mac, id_intel_llvm_nix, id_nag)
+        flag_cpp_preprocessor = "-fpp"
+    case(id_lfortran)
+        flag_cpp_preprocessor = "--cpp"
+    end select
+
+    do i = 1, size(package%preprocess)
+        if (package%preprocess(i)%name == "cpp") then
+            flags = flag_cpp_preprocessor// flags
+            exit
+        end if
+    end do
+
+end subroutine set_preprocessor_flags
+
 function get_include_flag(self, path) result(flags)
     class(compiler_t), intent(in) :: self
     character(len=*), intent(in) :: path