From 26468d2454e1ec4d61dc43de750f19126c9dbde7 Mon Sep 17 00:00:00 2001 From: arteevraina Date: Sat, 27 Aug 2022 11:42:33 +0530 Subject: [PATCH 01/18] feat: added support for cpp files compilation --- src/fpm.f90 | 2 +- src/fpm_backend.F90 | 7 +++- src/fpm_command_line.f90 | 11 +++++- src/fpm_compiler.f90 | 62 +++++++++++++++++++++++++++++- src/fpm_model.f90 | 8 +++- src/fpm_source_parsing.f90 | 79 +++++++++++++++++++++++++++++++++++++- src/fpm_sources.f90 | 8 +++- src/fpm_targets.f90 | 12 +++++- 8 files changed, 177 insertions(+), 12 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index e942bf5039..73c8411dd4 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -65,7 +65,7 @@ subroutine build_model(model, settings, package, error) end if call new_compiler(model%compiler, settings%compiler, settings%c_compiler, & - & echo=settings%verbose, verbose=settings%verbose) + & settings%cpp_compiler, echo=settings%verbose, verbose=settings%verbose) call new_archiver(model%archiver, settings%archiver, & & echo=settings%verbose, verbose=settings%verbose) diff --git a/src/fpm_backend.F90 b/src/fpm_backend.F90 index 292ae81743..94a60abf9c 100644 --- a/src/fpm_backend.F90 +++ b/src/fpm_backend.F90 @@ -33,7 +33,8 @@ module fpm_backend use fpm_model, only: fpm_model_t use fpm_strings, only: string_t, operator(.in.) use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, & - FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE + FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE, & + FPM_TARGET_CPP_OBJECT use fpm_backend_output implicit none @@ -323,6 +324,10 @@ subroutine build_target(model,target,verbose,stat) call model%compiler%compile_c(target%source%file_name, target%output_file, & & target%compile_flags, target%output_log_file, stat) + case (FPM_TARGET_CPP_OBJECT) + call model%compiler%compile_cpp(target%source%file_name, target%output_file, & + & target%compile_flags, target%output_log_file, stat) + case (FPM_TARGET_EXECUTABLE) call model%compiler%link(target%output_file, & & target%compile_flags//" "//target%link_flags, target%output_log_file, stat) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index e0c7ec17fb..ae24770125 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -74,6 +74,7 @@ module fpm_command_line logical :: prune=.true. character(len=:),allocatable :: compiler character(len=:),allocatable :: c_compiler + character(len=:),allocatable :: cpp_compiler character(len=:),allocatable :: archiver character(len=:),allocatable :: profile character(len=:),allocatable :: flag @@ -197,11 +198,12 @@ subroutine get_command_line_settings(cmd_settings) logical :: unix type(fpm_install_settings), allocatable :: install_settings character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, & - & c_compiler, archiver + & c_compiler, cpp_compiler, archiver character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", & & fflags_env = "FFLAGS", cflags_env = "CFLAGS", ldflags_env = "LDFLAGS", & - & fc_default = "gfortran", cc_default = " ", ar_default = " ", flags_default = " " + & fc_default = "gfortran", cc_default = " ", ar_default = " ", flags_default = " ", & + & cppc_env = "CPPC", cppc_default = " " type(error_t), allocatable :: error call set_help() @@ -245,6 +247,7 @@ subroutine get_command_line_settings(cmd_settings) ' --no-prune F' // & ' --compiler "'//get_fpm_env(fc_env, fc_default)//'"' // & ' --c-compiler "'//get_fpm_env(cc_env, cc_default)//'"' // & + ' --cpp-compiler "'//get_fpm_env(cppc_env, cppc_default)//'"' // & ' --archiver "'//get_fpm_env(ar_env, ar_default)//'"' // & ' --flag:: "'//get_fpm_env(fflags_env, flags_default)//'"' // & ' --c-flag:: "'//get_fpm_env(cflags_env, flags_default)//'"' // & @@ -286,6 +289,7 @@ subroutine get_command_line_settings(cmd_settings) enddo c_compiler = sget('c-compiler') + cpp_compiler = sget('cpp-compiler') archiver = sget('archiver') allocate(fpm_run_settings :: cmd_settings) val_runner=sget('runner') @@ -317,6 +321,7 @@ subroutine get_command_line_settings(cmd_settings) call check_build_vals() c_compiler = sget('c-compiler') + cpp_compiler = sget('cpp-compiler') archiver = sget('archiver') allocate( fpm_build_settings :: cmd_settings ) cmd_settings=fpm_build_settings( & @@ -470,6 +475,7 @@ subroutine get_command_line_settings(cmd_settings) call check_build_vals() c_compiler = sget('c-compiler') + cpp_compiler = sget('cpp-compiler') archiver = sget('archiver') allocate(install_settings) install_settings = fpm_install_settings(& @@ -523,6 +529,7 @@ subroutine get_command_line_settings(cmd_settings) enddo c_compiler = sget('c-compiler') + cpp_compiler = sget('cpp-compiler') archiver = sget('archiver') allocate(fpm_test_settings :: cmd_settings) val_runner=sget('runner') diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index be4296ad8e..bf4a3bc204 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -81,6 +81,8 @@ module fpm_compiler character(len=:), allocatable :: fc !> Path to the C compiler character(len=:), allocatable :: cc + !> Path to the C++ compiler + character(len=:), allocatable :: cppc !> Print all commands logical :: echo = .true. !> Verbose output of command @@ -96,6 +98,8 @@ module fpm_compiler procedure :: compile_fortran !> Compile a C object procedure :: compile_c + !> Compile a CPP object + procedure :: compile_cpp !> Link executable procedure :: link !> Check whether compiler is recognized @@ -583,6 +587,41 @@ subroutine get_default_c_compiler(f_compiler, c_compiler) end subroutine get_default_c_compiler +!> Get C++ Compiler. +subroutine get_default_cpp_compiler(f_compiler, c_compiler) + character(len=*), intent(in) :: f_compiler + character(len=:), allocatable, intent(out) :: c_compiler + integer(compiler_enum) :: id + + id = get_compiler_id(f_compiler) + + select case(id) + + case(id_intel_classic_nix, id_intel_classic_mac, id_intel_classic_windows) + c_compiler = 'icpc' + + case(id_intel_llvm_nix,id_intel_llvm_windows) + c_compiler = 'icpx' + + case(id_flang, id_flang_new, id_f18) + c_compiler='clang' + + case(id_ibmxl) + c_compiler='xlc++' + + case(id_lfortran) + c_compiler = 'cc' + + case(id_gcc) + c_compiler = 'g++' + + case default + ! Fall-back to using Fortran compiler + c_compiler = f_compiler + end select + +end subroutine get_default_cpp_compiler + function get_compiler_id(compiler) result(id) character(len=*), intent(in) :: compiler @@ -754,13 +793,15 @@ end function enumerate_libraries !> Create new compiler instance -subroutine new_compiler(self, fc, cc, echo, verbose) +subroutine new_compiler(self, fc, cc, cppc, echo, verbose) !> New instance of the compiler type(compiler_t), intent(out) :: self !> Fortran compiler name or path character(len=*), intent(in) :: fc !> C compiler name or path character(len=*), intent(in) :: cc + !> C++ Compiler name or path + character(len=*), intent(in) :: cppc !> Echo compiler command logical, intent(in) :: echo !> Verbose mode: dump compiler output @@ -775,6 +816,7 @@ subroutine new_compiler(self, fc, cc, echo, verbose) self%cc = cc else call get_default_c_compiler(self%fc, self%cc) + call get_default_cpp_compiler(self%fc, self%cppc) end if end subroutine new_compiler @@ -866,6 +908,24 @@ subroutine compile_c(self, input, output, args, log_file, stat) & echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) end subroutine compile_c +!> Compile a CPP object +subroutine compile_cpp(self, input, output, args, log_file, stat) + !> Instance of the compiler object + class(compiler_t), intent(in) :: self + !> Source file input + character(len=*), intent(in) :: input + !> Output file of object + character(len=*), intent(in) :: output + !> Arguments for compiler + character(len=*), intent(in) :: args + !> Compiler output log file + character(len=*), intent(in) :: log_file + !> Status flag + integer, intent(out) :: stat + + call run(self%cppc // " -c " // input // " " // args // " -o " // output, & + & echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) +end subroutine compile_cpp !> Link an executable subroutine link(self, output, args, log_file, stat) diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index e77b98debd..86cf8f67b2 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -47,7 +47,8 @@ module fpm_model public :: FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, & - FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST + FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST, & + FPM_UNIT_CPPSOURCE !> Source type unknown integer, parameter :: FPM_UNIT_UNKNOWN = -1 @@ -63,7 +64,8 @@ module fpm_model integer, parameter :: FPM_UNIT_CSOURCE = 5 !> Source type is c header file integer, parameter :: FPM_UNIT_CHEADER = 6 - +!> Souce type is c++ source file. +integer, parameter :: FPM_UNIT_CPPSOURCE = 7 !> Source has no module-use scope integer, parameter :: FPM_SCOPE_UNKNOWN = -1 @@ -254,6 +256,8 @@ function info_srcfile(source) result(s) s = s // "FPM_UNIT_SUBPROGRAM" case (FPM_UNIT_CSOURCE) s = s // "FPM_UNIT_CSOURCE" + case (FPM_UNIT_CPPSOURCE) + s = s // "FPM_UNIT_CPPSOURCE" case (FPM_UNIT_CHEADER) s = s // "FPM_UNIT_CHEADER" case default diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 09716107d8..d0cca573b3 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -21,12 +21,13 @@ module fpm_source_parsing FPM_UNIT_UNKNOWN, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, & FPM_UNIT_CSOURCE, FPM_UNIT_CHEADER, FPM_SCOPE_UNKNOWN, & - FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST + FPM_SCOPE_LIB, FPM_SCOPE_DEP, FPM_SCOPE_APP, FPM_SCOPE_TEST, & + FPM_UNIT_CPPSOURCE use fpm_filesystem, only: read_lines, read_lines_expanded, exists implicit none private -public :: parse_f_source, parse_c_source +public :: parse_f_source, parse_c_source, parse_cpp_source character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & ['iso_c_binding ', & @@ -512,6 +513,80 @@ function parse_c_source(c_filename,error) result(c_source) end function parse_c_source +!> Parsing of cpp source files +!> +!> The following statements are recognised and parsed: +!> +!> - `#include` preprocessor statement +!> +function parse_cpp_source(c_filename,error) result(cpp_source) + character(*), intent(in) :: c_filename + type(srcfile_t) :: cpp_source + type(error_t), allocatable, intent(out) :: error + + integer :: fh, n_include, i, pass, stat + type(string_t), allocatable :: file_lines(:) + + cpp_source%file_name = c_filename + + if (str_ends_with(lower(c_filename), ".cpp")) then + + cpp_source%unit_type = FPM_UNIT_CPPSOURCE + + end if + + allocate(cpp_source%modules_used(0)) + allocate(cpp_source%modules_provided(0)) + allocate(cpp_source%parent_modules(0)) + + open(newunit=fh,file=c_filename,status='old') + file_lines = read_lines(fh) + close(fh) + + ! Ignore empty files, returned as FPM_UNIT_UNKNOWN + if (len_trim(file_lines) < 1) then + cpp_source%unit_type = FPM_UNIT_UNKNOWN + return + end if + + cpp_source%digest = fnv_1a(file_lines) + + do pass = 1,2 + n_include = 0 + file_loop: do i=1,size(file_lines) + + ! Process 'INCLUDE' statements + if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & + index(file_lines(i)%s,'"') > 0) then + + n_include = n_include + 1 + + if (pass == 2) then + + cpp_source%include_dependencies(n_include)%s = & + & split_n(file_lines(i)%s,n=2,delims='"',stat=stat) + if (stat /= 0) then + call file_parse_error(error,c_filename, & + 'unable to get cpp include file',i, & + file_lines(i)%s,index(file_lines(i)%s,'"')) + return + end if + + end if + + end if + + end do file_loop + + if (pass == 1) then + allocate(cpp_source%include_dependencies(n_include)) + end if + + end do + +end function parse_cpp_source + + !> Split a string on one or more delimeters !> and return the nth substring if it exists !> diff --git a/src/fpm_sources.f90 b/src/fpm_sources.f90 index 9fcc5e6b86..50b8faf9ad 100644 --- a/src/fpm_sources.f90 +++ b/src/fpm_sources.f90 @@ -8,7 +8,7 @@ module fpm_sources use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM use fpm_filesystem, only: basename, canon_path, dirname, join_path, list_files, is_hidden_file use fpm_strings, only: lower, str_ends_with, string_t, operator(.in.) -use fpm_source_parsing, only: parse_f_source, parse_c_source +use fpm_source_parsing, only: parse_f_source, parse_c_source, parse_cpp_source use fpm_manifest_executable, only: executable_config_t implicit none @@ -39,6 +39,10 @@ function parse_source(source_file_path,error) result(source) source = parse_c_source(source_file_path,error) + else if (str_ends_with(lower(source_file_path), [".cpp"])) then + + source = parse_cpp_source(source_file_path, error) + end if if (allocated(error)) then @@ -84,7 +88,7 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,recurse is_source = [(.not.(is_hidden_file(basename(file_names(i)%s))) .and. & .not.(canon_path(file_names(i)%s) .in. existing_src_files) .and. & (str_ends_with(lower(file_names(i)%s), fortran_suffixes) .or. & - str_ends_with(lower(file_names(i)%s),[".c",".h"]) ),i=1,size(file_names))] + str_ends_with(lower(file_names(i)%s),[".c ",".h ", ".cpp"]) ),i=1,size(file_names))] src_file_names = pack(file_names,is_source) allocate(dir_sources(size(src_file_names))) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 05d556799a..9f31d14c12 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -37,7 +37,7 @@ module fpm_targets public FPM_TARGET_UNKNOWN, FPM_TARGET_EXECUTABLE, & FPM_TARGET_ARCHIVE, FPM_TARGET_OBJECT, & - FPM_TARGET_C_OBJECT + FPM_TARGET_C_OBJECT, FPM_TARGET_CPP_OBJECT public build_target_t, build_target_ptr public targets_from_sources, resolve_module_dependencies public resolve_target_linking, add_target, add_dependency @@ -55,6 +55,8 @@ module fpm_targets integer, parameter :: FPM_TARGET_OBJECT = 3 !> Target type is c compiled object integer, parameter :: FPM_TARGET_C_OBJECT = 4 +!> Target type is cpp compiled object +integer, parameter :: FPM_TARGET_CPP_OBJECT = 5 !> Wrapper type for constructing arrays of `[[build_target_t]]` pointers type build_target_ptr @@ -238,6 +240,14 @@ subroutine build_target_list(targets,model) call add_dependency(targets(1)%ptr, targets(size(targets))%ptr) end if + case (FPM_UNIT_CPPSOURCE) + + call add_target(targets,package=model%packages(j)%name,source = sources(i), & + type = FPM_UNIT_CPPSOURCE, & + output_name = get_object_name(sources(i)), & + macros = model%packages(j)%macros, & + version = model%packages(j)%version) + case (FPM_UNIT_PROGRAM) call add_target(targets,package=model%packages(j)%name,type = FPM_TARGET_OBJECT,& From 9fc44cc22c0094603311131f3bc326027b4747f8 Mon Sep 17 00:00:00 2001 From: arteevraina Date: Sat, 27 Aug 2022 11:44:04 +0530 Subject: [PATCH 02/18] test: added test for cpp_source parsing --- test/fpm_test/test_source_parsing.f90 | 83 ++++++++++++++++++++++++++- 1 file changed, 80 insertions(+), 3 deletions(-) diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index 34f4dce354..69f41ab006 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -2,9 +2,10 @@ module test_source_parsing use testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_filesystem, only: get_temp_filename - use fpm_source_parsing, only: parse_f_source, parse_c_source + use fpm_source_parsing, only: parse_f_source, parse_c_source, parse_cpp_source use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & - FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE + FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & + FPM_UNIT_CPPSOURCE use fpm_strings, only: operator(.in.) implicit none private @@ -41,7 +42,8 @@ subroutine collect_source_parsing(testsuite) & new_unittest("invalid-module", & test_invalid_module, should_fail=.true.), & & new_unittest("invalid-submodule", & - test_invalid_submodule, should_fail=.true.) & + test_invalid_submodule, should_fail=.true.), & + & new_unittest("cppsource", test_cppsource) & ] end subroutine collect_source_parsing @@ -836,6 +838,81 @@ subroutine test_csource(error) end subroutine test_csource + !> Try to parse standard cpp source for includes + subroutine test_cppsource(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + temp_file = temp_file//'.cpp' + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & '#include "file1.h"', & + & '#include "file2.h"', & + & 'void sum(int a) {', & + & ' #include "function_body.cpp"', & + & ' // This is the function body.', & + & ' return', & + & '}' + close(unit) + + f_source = parse_cpp_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (f_source%unit_type /= FPM_UNIT_CPPSOURCE) then + call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_CSOURCE') + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 0) then + call test_failed(error,'Incorrect number of modules_used - expecting zero') + return + end if + + if (size(f_source%include_dependencies) /= 3) then + call test_failed(error,'Incorrect number of include_dependencies - expecting two') + return + end if + + if (allocated(f_source%link_libraries)) then + call test_failed(error,'Unexpected link_libraries - expecting unallocated') + return + end if + + if (size(f_source%parent_modules) /= 0) then + call test_failed(error,'Incorrect number of parent_modules - expecting zero') + return + end if + + if (.not.('file1.h' .in. f_source%include_dependencies)) then + call test_failed(error,'Missing file in include_dependencies') + return + end if + + if (.not.('file2.h' .in. f_source%include_dependencies)) then + call test_failed(error,'Missing file in include_dependencies') + return + end if + + if (.not.('function_body.cpp' .in. f_source%include_dependencies)) then + call test_failed(error,'Missing file in include_dependencies') + return + end if + + end subroutine test_cppsource !> Try to parse fortran program with invalid use statement subroutine test_invalid_use_stmt(error) From 08b0815ac2063c67ad3a60c255e1fa71944d6df9 Mon Sep 17 00:00:00 2001 From: arteevraina Date: Sun, 28 Aug 2022 18:28:22 +0530 Subject: [PATCH 03/18] refactor: removed parse_cpp_source subroutine and test for it --- src/fpm_source_parsing.f90 | 84 +++------------------------ src/fpm_sources.f90 | 9 +-- test/fpm_test/test_source_parsing.f90 | 81 +------------------------- 3 files changed, 12 insertions(+), 162 deletions(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index d0cca573b3..6d22ef4a6c 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -27,7 +27,7 @@ module fpm_source_parsing implicit none private -public :: parse_f_source, parse_c_source, parse_cpp_source +public :: parse_f_source, parse_c_source character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & ['iso_c_binding ', & @@ -436,7 +436,7 @@ function parse_f_source(f_filename,error) result(f_source) end function parse_f_source -!> Parsing of c source files +!> Parsing of c, cpp source files !> !> The following statements are recognised and parsed: !> @@ -456,10 +456,14 @@ function parse_c_source(c_filename,error) result(c_source) c_source%unit_type = FPM_UNIT_CSOURCE - elseif (str_ends_with(lower(c_filename), ".h")) then + else if (str_ends_with(lower(c_filename), ".h")) then c_source%unit_type = FPM_UNIT_CHEADER + else if (str_ends_with(lower(c_filename), ".cpp")) then + + c_source%unit_type = FPM_UNIT_CPPSOURCE + end if allocate(c_source%modules_used(0)) @@ -513,80 +517,6 @@ function parse_c_source(c_filename,error) result(c_source) end function parse_c_source -!> Parsing of cpp source files -!> -!> The following statements are recognised and parsed: -!> -!> - `#include` preprocessor statement -!> -function parse_cpp_source(c_filename,error) result(cpp_source) - character(*), intent(in) :: c_filename - type(srcfile_t) :: cpp_source - type(error_t), allocatable, intent(out) :: error - - integer :: fh, n_include, i, pass, stat - type(string_t), allocatable :: file_lines(:) - - cpp_source%file_name = c_filename - - if (str_ends_with(lower(c_filename), ".cpp")) then - - cpp_source%unit_type = FPM_UNIT_CPPSOURCE - - end if - - allocate(cpp_source%modules_used(0)) - allocate(cpp_source%modules_provided(0)) - allocate(cpp_source%parent_modules(0)) - - open(newunit=fh,file=c_filename,status='old') - file_lines = read_lines(fh) - close(fh) - - ! Ignore empty files, returned as FPM_UNIT_UNKNOWN - if (len_trim(file_lines) < 1) then - cpp_source%unit_type = FPM_UNIT_UNKNOWN - return - end if - - cpp_source%digest = fnv_1a(file_lines) - - do pass = 1,2 - n_include = 0 - file_loop: do i=1,size(file_lines) - - ! Process 'INCLUDE' statements - if (index(adjustl(lower(file_lines(i)%s)),'#include') == 1 .and. & - index(file_lines(i)%s,'"') > 0) then - - n_include = n_include + 1 - - if (pass == 2) then - - cpp_source%include_dependencies(n_include)%s = & - & split_n(file_lines(i)%s,n=2,delims='"',stat=stat) - if (stat /= 0) then - call file_parse_error(error,c_filename, & - 'unable to get cpp include file',i, & - file_lines(i)%s,index(file_lines(i)%s,'"')) - return - end if - - end if - - end if - - end do file_loop - - if (pass == 1) then - allocate(cpp_source%include_dependencies(n_include)) - end if - - end do - -end function parse_cpp_source - - !> Split a string on one or more delimeters !> and return the nth substring if it exists !> diff --git a/src/fpm_sources.f90 b/src/fpm_sources.f90 index 50b8faf9ad..a3f9574efc 100644 --- a/src/fpm_sources.f90 +++ b/src/fpm_sources.f90 @@ -8,7 +8,7 @@ module fpm_sources use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM use fpm_filesystem, only: basename, canon_path, dirname, join_path, list_files, is_hidden_file use fpm_strings, only: lower, str_ends_with, string_t, operator(.in.) -use fpm_source_parsing, only: parse_f_source, parse_c_source, parse_cpp_source +use fpm_source_parsing, only: parse_f_source, parse_c_source use fpm_manifest_executable, only: executable_config_t implicit none @@ -17,6 +17,7 @@ module fpm_sources character(4), parameter :: fortran_suffixes(2) = [".f90", & ".f "] +character(4), parameter :: c_suffixes(3) = [".c ", ".h ", ".cpp"] contains @@ -35,14 +36,10 @@ function parse_source(source_file_path,error) result(source) source%exe_name = basename(source_file_path,suffix=.false.) end if - else if (str_ends_with(lower(source_file_path), [".c", ".h"])) then + else if (str_ends_with(lower(source_file_path), c_suffixes)) then source = parse_c_source(source_file_path,error) - else if (str_ends_with(lower(source_file_path), [".cpp"])) then - - source = parse_cpp_source(source_file_path, error) - end if if (allocated(error)) then diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index 69f41ab006..73e7e6b162 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -2,7 +2,7 @@ module test_source_parsing use testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_filesystem, only: get_temp_filename - use fpm_source_parsing, only: parse_f_source, parse_c_source, parse_cpp_source + use fpm_source_parsing, only: parse_f_source, parse_c_source use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & FPM_UNIT_CPPSOURCE @@ -42,8 +42,7 @@ subroutine collect_source_parsing(testsuite) & new_unittest("invalid-module", & test_invalid_module, should_fail=.true.), & & new_unittest("invalid-submodule", & - test_invalid_submodule, should_fail=.true.), & - & new_unittest("cppsource", test_cppsource) & + test_invalid_submodule, should_fail=.true.) & ] end subroutine collect_source_parsing @@ -838,82 +837,6 @@ subroutine test_csource(error) end subroutine test_csource - !> Try to parse standard cpp source for includes - subroutine test_cppsource(error) - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - integer :: unit - character(:), allocatable :: temp_file - type(srcfile_t), allocatable :: f_source - - allocate(temp_file, source=get_temp_filename()) - temp_file = temp_file//'.cpp' - - open(file=temp_file, newunit=unit) - write(unit, '(a)') & - & '#include "file1.h"', & - & '#include "file2.h"', & - & 'void sum(int a) {', & - & ' #include "function_body.cpp"', & - & ' // This is the function body.', & - & ' return', & - & '}' - close(unit) - - f_source = parse_cpp_source(temp_file,error) - if (allocated(error)) then - return - end if - - if (f_source%unit_type /= FPM_UNIT_CPPSOURCE) then - call test_failed(error,'Wrong unit type detected - expecting FPM_UNIT_CSOURCE') - return - end if - - if (size(f_source%modules_provided) /= 0) then - call test_failed(error,'Unexpected modules_provided - expecting zero') - return - end if - - if (size(f_source%modules_used) /= 0) then - call test_failed(error,'Incorrect number of modules_used - expecting zero') - return - end if - - if (size(f_source%include_dependencies) /= 3) then - call test_failed(error,'Incorrect number of include_dependencies - expecting two') - return - end if - - if (allocated(f_source%link_libraries)) then - call test_failed(error,'Unexpected link_libraries - expecting unallocated') - return - end if - - if (size(f_source%parent_modules) /= 0) then - call test_failed(error,'Incorrect number of parent_modules - expecting zero') - return - end if - - if (.not.('file1.h' .in. f_source%include_dependencies)) then - call test_failed(error,'Missing file in include_dependencies') - return - end if - - if (.not.('file2.h' .in. f_source%include_dependencies)) then - call test_failed(error,'Missing file in include_dependencies') - return - end if - - if (.not.('function_body.cpp' .in. f_source%include_dependencies)) then - call test_failed(error,'Missing file in include_dependencies') - return - end if - - end subroutine test_cppsource - !> Try to parse fortran program with invalid use statement subroutine test_invalid_use_stmt(error) From 8e4e3f926b963bd9873d6abe61df62c8311e299e Mon Sep 17 00:00:00 2001 From: arteevraina Date: Sun, 28 Aug 2022 18:29:01 +0530 Subject: [PATCH 04/18] fix: added link flag if unit type is CPP --- src/fpm_targets.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 9f31d14c12..6519756fc0 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -248,6 +248,9 @@ subroutine build_target_list(targets,model) macros = model%packages(j)%macros, & version = model%packages(j)%version) + !> Add stdc++ as a linker flag. + model%link_flags = model%link_flags // "stdc++" + case (FPM_UNIT_PROGRAM) call add_target(targets,package=model%packages(j)%name,type = FPM_TARGET_OBJECT,& From 8d695c595a984563dd66da0d1502001bc32a1c8c Mon Sep 17 00:00:00 2001 From: arteevraina Date: Sun, 28 Aug 2022 18:30:27 +0530 Subject: [PATCH 05/18] docs: added example package --- example_packages/cpp_files/README.md | 2 ++ example_packages/cpp_files/fpm.toml | 12 ++++++++++++ example_packages/cpp_files/src/cpp_files.f90 | 12 ++++++++++++ example_packages/cpp_files/src/hello_world.cpp | 9 +++++++++ example_packages/cpp_files/test/check.f90 | 5 +++++ 5 files changed, 40 insertions(+) create mode 100644 example_packages/cpp_files/README.md create mode 100644 example_packages/cpp_files/fpm.toml create mode 100644 example_packages/cpp_files/src/cpp_files.f90 create mode 100644 example_packages/cpp_files/src/hello_world.cpp create mode 100644 example_packages/cpp_files/test/check.f90 diff --git a/example_packages/cpp_files/README.md b/example_packages/cpp_files/README.md new file mode 100644 index 0000000000..ff795a76bb --- /dev/null +++ b/example_packages/cpp_files/README.md @@ -0,0 +1,2 @@ +# cpp_files +My cool new project! diff --git a/example_packages/cpp_files/fpm.toml b/example_packages/cpp_files/fpm.toml new file mode 100644 index 0000000000..eb60a97b16 --- /dev/null +++ b/example_packages/cpp_files/fpm.toml @@ -0,0 +1,12 @@ +name = "cpp_files" +version = "0.1.0" +license = "license" +author = "arteevraina" +maintainer = "arteevraina@gmail.com" +copyright = "Copyright 2022, arteevraina" +[build] +auto-executables = true +auto-tests = true +auto-examples = true +[install] +library = false diff --git a/example_packages/cpp_files/src/cpp_files.f90 b/example_packages/cpp_files/src/cpp_files.f90 new file mode 100644 index 0000000000..445b2ea935 --- /dev/null +++ b/example_packages/cpp_files/src/cpp_files.f90 @@ -0,0 +1,12 @@ +module cpp_files + use, intrinsic :: ISO_C_Binding + implicit none + private + + public :: hello_world + + interface + subroutine hello_world() bind(C, name = "hello_world") + end subroutine hello_world + end interface +end module cpp_files diff --git a/example_packages/cpp_files/src/hello_world.cpp b/example_packages/cpp_files/src/hello_world.cpp new file mode 100644 index 0000000000..a355c057b5 --- /dev/null +++ b/example_packages/cpp_files/src/hello_world.cpp @@ -0,0 +1,9 @@ +#include + +extern "C" { + int hello_world(); +} + +int hello_world() { + std::cout << "Hello World"; +} diff --git a/example_packages/cpp_files/test/check.f90 b/example_packages/cpp_files/test/check.f90 new file mode 100644 index 0000000000..d7e3cba687 --- /dev/null +++ b/example_packages/cpp_files/test/check.f90 @@ -0,0 +1,5 @@ +program check +implicit none + +print *, "Put some tests in here!" +end program check From ecac6ca4cd8082a39e50f1e77922c0f449724f2f Mon Sep 17 00:00:00 2001 From: arteevraina Date: Sun, 28 Aug 2022 18:31:42 +0530 Subject: [PATCH 06/18] chore: added example package to run in ci --- ci/run_tests.sh | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 7974932b37..ff53bd3160 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -126,5 +126,9 @@ pushd preprocess_hello "$fpm" build popd +pushd cpp_files +"$fpm" build +popd + # Cleanup rm -rf ./*/build From 484d2b3b7255b4b8d64338a86cce7b2cc4b99611 Mon Sep 17 00:00:00 2001 From: arteevraina Date: Sun, 28 Aug 2022 18:34:08 +0530 Subject: [PATCH 07/18] refactor: rename c_compile to cpp_compiler --- src/fpm_compiler.f90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index bf4a3bc204..dce484405c 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -588,9 +588,9 @@ subroutine get_default_c_compiler(f_compiler, c_compiler) end subroutine get_default_c_compiler !> Get C++ Compiler. -subroutine get_default_cpp_compiler(f_compiler, c_compiler) +subroutine get_default_cpp_compiler(f_compiler, cpp_compiler) character(len=*), intent(in) :: f_compiler - character(len=:), allocatable, intent(out) :: c_compiler + character(len=:), allocatable, intent(out) :: cpp_compiler integer(compiler_enum) :: id id = get_compiler_id(f_compiler) @@ -598,26 +598,26 @@ subroutine get_default_cpp_compiler(f_compiler, c_compiler) select case(id) case(id_intel_classic_nix, id_intel_classic_mac, id_intel_classic_windows) - c_compiler = 'icpc' + cpp_compiler = 'icpc' case(id_intel_llvm_nix,id_intel_llvm_windows) - c_compiler = 'icpx' + cpp_compiler = 'icpx' case(id_flang, id_flang_new, id_f18) - c_compiler='clang' + cpp_compiler='clang' case(id_ibmxl) - c_compiler='xlc++' + cpp_compiler='xlc++' case(id_lfortran) - c_compiler = 'cc' + cpp_compiler = 'cc' case(id_gcc) - c_compiler = 'g++' + cpp_compiler = 'g++' case default ! Fall-back to using Fortran compiler - c_compiler = f_compiler + cpp_compiler = f_compiler end select end subroutine get_default_cpp_compiler From d8de3ce72eeaa97a57026ddbc98f0b7aa216e8b4 Mon Sep 17 00:00:00 2001 From: arteevraina Date: Sun, 28 Aug 2022 18:38:05 +0530 Subject: [PATCH 08/18] refactor: rename cppc to cxx --- src/fpm_compiler.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index dce484405c..b4dd3f6801 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -82,7 +82,7 @@ module fpm_compiler !> Path to the C compiler character(len=:), allocatable :: cc !> Path to the C++ compiler - character(len=:), allocatable :: cppc + character(len=:), allocatable :: cxx !> Print all commands logical :: echo = .true. !> Verbose output of command @@ -816,7 +816,7 @@ subroutine new_compiler(self, fc, cc, cppc, echo, verbose) self%cc = cc else call get_default_c_compiler(self%fc, self%cc) - call get_default_cpp_compiler(self%fc, self%cppc) + call get_default_cpp_compiler(self%fc, self%cxx) end if end subroutine new_compiler @@ -923,7 +923,7 @@ subroutine compile_cpp(self, input, output, args, log_file, stat) !> Status flag integer, intent(out) :: stat - call run(self%cppc // " -c " // input // " " // args // " -o " // output, & + call run(self%cxx // " -c " // input // " " // args // " -o " // output, & & echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) end subroutine compile_cpp From 39a304d8b61c6cf0b5ca151d53ef6f4eb2c6efb7 Mon Sep 17 00:00:00 2001 From: arteevraina Date: Sun, 28 Aug 2022 18:42:39 +0530 Subject: [PATCH 09/18] refactor: cppc to cxx at leftout places --- src/fpm_command_line.f90 | 4 ++-- src/fpm_compiler.f90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index ae24770125..6c3a7b2fd3 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -203,7 +203,7 @@ subroutine get_command_line_settings(cmd_settings) character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", & & fflags_env = "FFLAGS", cflags_env = "CFLAGS", ldflags_env = "LDFLAGS", & & fc_default = "gfortran", cc_default = " ", ar_default = " ", flags_default = " ", & - & cppc_env = "CPPC", cppc_default = " " + & cxx_env = "CXX", cxx_default = " " type(error_t), allocatable :: error call set_help() @@ -247,7 +247,7 @@ subroutine get_command_line_settings(cmd_settings) ' --no-prune F' // & ' --compiler "'//get_fpm_env(fc_env, fc_default)//'"' // & ' --c-compiler "'//get_fpm_env(cc_env, cc_default)//'"' // & - ' --cpp-compiler "'//get_fpm_env(cppc_env, cppc_default)//'"' // & + ' --cpp-compiler "'//get_fpm_env(cxx_env, cxx_default)//'"' // & ' --archiver "'//get_fpm_env(ar_env, ar_default)//'"' // & ' --flag:: "'//get_fpm_env(fflags_env, flags_default)//'"' // & ' --c-flag:: "'//get_fpm_env(cflags_env, flags_default)//'"' // & diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index b4dd3f6801..ccb9c5946d 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -793,7 +793,7 @@ end function enumerate_libraries !> Create new compiler instance -subroutine new_compiler(self, fc, cc, cppc, echo, verbose) +subroutine new_compiler(self, fc, cc, cxx, echo, verbose) !> New instance of the compiler type(compiler_t), intent(out) :: self !> Fortran compiler name or path @@ -801,7 +801,7 @@ subroutine new_compiler(self, fc, cc, cppc, echo, verbose) !> C compiler name or path character(len=*), intent(in) :: cc !> C++ Compiler name or path - character(len=*), intent(in) :: cppc + character(len=*), intent(in) :: cxx !> Echo compiler command logical, intent(in) :: echo !> Verbose mode: dump compiler output From 97ea8ce81b141a69900d464137e153460daea569 Mon Sep 17 00:00:00 2001 From: arteevraina Date: Sun, 28 Aug 2022 18:44:38 +0530 Subject: [PATCH 10/18] refactor: remove boiler plate from fpm.toml of added example --- example_packages/cpp_files/fpm.toml | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/example_packages/cpp_files/fpm.toml b/example_packages/cpp_files/fpm.toml index eb60a97b16..1e29a93c40 100644 --- a/example_packages/cpp_files/fpm.toml +++ b/example_packages/cpp_files/fpm.toml @@ -1,12 +1 @@ name = "cpp_files" -version = "0.1.0" -license = "license" -author = "arteevraina" -maintainer = "arteevraina@gmail.com" -copyright = "Copyright 2022, arteevraina" -[build] -auto-executables = true -auto-tests = true -auto-examples = true -[install] -library = false From 510082726aad0bd876437b438e03515dcf0dd648 Mon Sep 17 00:00:00 2001 From: arteevraina Date: Mon, 29 Aug 2022 22:11:23 +0530 Subject: [PATCH 11/18] refactor: added requested changes --- ci/run_tests.sh | 2 +- src/fpm.f90 | 4 +++- src/fpm_command_line.f90 | 11 +++++++++-- src/fpm_compiler.f90 | 5 +++++ src/fpm_model.f90 | 4 ++++ src/fpm_sources.f90 | 2 +- src/fpm_targets.f90 | 19 ++++++++++++++----- 7 files changed, 37 insertions(+), 10 deletions(-) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index ff53bd3160..a6396ad9ae 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -127,7 +127,7 @@ pushd preprocess_hello popd pushd cpp_files -"$fpm" build +"$fpm" test popd # Cleanup diff --git a/src/fpm.f90 b/src/fpm.f90 index 73c8411dd4..497cb6a036 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -43,7 +43,7 @@ subroutine build_model(model, settings, package, error) integer :: i, j type(package_config_t) :: dependency - character(len=:), allocatable :: manifest, lib_dir, flags, cflags, ldflags + character(len=:), allocatable :: manifest, lib_dir, flags, cflags, cxxflags, ldflags character(len=:), allocatable :: version logical :: duplicates_found = .false. @@ -82,6 +82,7 @@ subroutine build_model(model, settings, package, error) call set_preprocessor_flags(model%compiler%id, flags, package) cflags = trim(settings%cflag) + cxxflags = trim(settings%cxxflag) ldflags = trim(settings%ldflag) if (model%compiler%is_unknown()) then @@ -93,6 +94,7 @@ subroutine build_model(model, settings, package, error) model%fortran_compile_flags = flags model%c_compile_flags = cflags + model%cpp_compile_flags = cxxflags model%link_flags = ldflags model%include_tests = settings%build_tests diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 6c3a7b2fd3..7401f54c76 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -79,6 +79,7 @@ module fpm_command_line character(len=:),allocatable :: profile character(len=:),allocatable :: flag character(len=:),allocatable :: cflag + character(len=:),allocatable :: cxxflag character(len=:),allocatable :: ldflag end type @@ -129,7 +130,7 @@ module fpm_command_line & ' ', 'fpm', 'new', 'build', 'run', 'clean', & & 'test', 'runner', 'install', 'update', 'list', 'help', 'version' ] -character(len=:), allocatable :: val_runner, val_compiler, val_flag, val_cflag, val_ldflag, & +character(len=:), allocatable :: val_runner, val_compiler, val_flag, val_cflag, val_cxxflag, val_ldflag, & val_profile ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& @@ -201,7 +202,7 @@ subroutine get_command_line_settings(cmd_settings) & c_compiler, cpp_compiler, archiver character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", & - & fflags_env = "FFLAGS", cflags_env = "CFLAGS", ldflags_env = "LDFLAGS", & + & fflags_env = "FFLAGS", cflags_env = "CFLAGS", cxxflags_env = "CXXFLAGS", ldflags_env = "LDFLAGS", & & fc_default = "gfortran", cc_default = " ", ar_default = " ", flags_default = " ", & & cxx_env = "CXX", cxx_default = " " type(error_t), allocatable :: error @@ -251,6 +252,7 @@ subroutine get_command_line_settings(cmd_settings) ' --archiver "'//get_fpm_env(ar_env, ar_default)//'"' // & ' --flag:: "'//get_fpm_env(fflags_env, flags_default)//'"' // & ' --c-flag:: "'//get_fpm_env(cflags_env, flags_default)//'"' // & + ' --cxx-flag:: "'//get_fpm_env(cxxflags_env, flags_default)//'"' // & ' --link-flag:: "'//get_fpm_env(ldflags_env, flags_default)//'"' ! now set subcommand-specific help text and process commandline @@ -303,6 +305,7 @@ subroutine get_command_line_settings(cmd_settings) & archiver=archiver, & & flag=val_flag, & & cflag=val_cflag, & + & cxxflag=val_cxxflag, & & ldflag=val_ldflag, & & example=lget('example'), & & list=lget('list'),& @@ -332,6 +335,7 @@ subroutine get_command_line_settings(cmd_settings) & archiver=archiver, & & flag=val_flag, & & cflag=val_cflag, & + & cxxflag=val_cxxflag, & & ldflag=val_ldflag, & & list=lget('list'),& & show_model=lget('show-model'),& @@ -487,6 +491,7 @@ subroutine get_command_line_settings(cmd_settings) archiver=archiver, & flag=val_flag, & cflag=val_cflag, & + cxxflag=val_cxxflag, & ldflag=val_ldflag, & no_rebuild=lget('no-rebuild'), & verbose=lget('verbose')) @@ -543,6 +548,7 @@ subroutine get_command_line_settings(cmd_settings) & archiver=archiver, & & flag=val_flag, & & cflag=val_cflag, & + & cxxflag=val_cxxflag, & & ldflag=val_ldflag, & & example=.false., & & list=lget('list'), & @@ -623,6 +629,7 @@ subroutine check_build_vals() val_flag = " " // sget('flag') val_cflag = " " // sget('c-flag') + val_cxxflag = " "// sget('cxx-flag') val_ldflag = " " // sget('link-flag') val_profile = sget('profile') diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index ccb9c5946d..8417f8c811 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -816,6 +816,11 @@ subroutine new_compiler(self, fc, cc, cxx, echo, verbose) self%cc = cc else call get_default_c_compiler(self%fc, self%cc) + end if + + if (len_trim(cxx) > 0) then + self%cxx = cxx + else call get_default_cpp_compiler(self%fc, self%cxx) end if end subroutine new_compiler diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index 86cf8f67b2..f1171c55bb 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -155,6 +155,9 @@ module fpm_model !> Command line flags passed to C for compilation character(:), allocatable :: c_compile_flags + !> Command line flags passed to C++ for compilation + character(:), allocatable :: cpp_compile_flags + !> Command line flags passed to the linker character(:), allocatable :: link_flags @@ -319,6 +322,7 @@ function info_model(model) result(s) ! character(:), allocatable :: fortran_compile_flags s = s // ', fortran_compile_flags="' // model%fortran_compile_flags // '"' s = s // ', c_compile_flags="' // model%c_compile_flags // '"' + s = s // ', cpp_compile_flags="' // model%cpp_compile_flags // '"' s = s // ', link_flags="' // model%link_flags // '"' s = s // ', build_prefix="' // model%build_prefix // '"' ! type(string_t), allocatable :: link_libraries(:) diff --git a/src/fpm_sources.f90 b/src/fpm_sources.f90 index a3f9574efc..5bb487f9f5 100644 --- a/src/fpm_sources.f90 +++ b/src/fpm_sources.f90 @@ -85,7 +85,7 @@ subroutine add_sources_from_dir(sources,directory,scope,with_executables,recurse is_source = [(.not.(is_hidden_file(basename(file_names(i)%s))) .and. & .not.(canon_path(file_names(i)%s) .in. existing_src_files) .and. & (str_ends_with(lower(file_names(i)%s), fortran_suffixes) .or. & - str_ends_with(lower(file_names(i)%s),[".c ",".h ", ".cpp"]) ),i=1,size(file_names))] + str_ends_with(lower(file_names(i)%s), c_suffixes) ),i=1,size(file_names))] src_file_names = pack(file_names,is_source) allocate(dir_sources(size(src_file_names))) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 6519756fc0..c5c66f7375 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -243,13 +243,20 @@ subroutine build_target_list(targets,model) case (FPM_UNIT_CPPSOURCE) call add_target(targets,package=model%packages(j)%name,source = sources(i), & - type = FPM_UNIT_CPPSOURCE, & + type = FPM_TARGET_CPP_OBJECT, & output_name = get_object_name(sources(i)), & macros = model%packages(j)%macros, & version = model%packages(j)%version) - !> Add stdc++ as a linker flag. - model%link_flags = model%link_flags // "stdc++" + if (with_lib .and. sources(i)%unit_scope == FPM_SCOPE_LIB) then + ! Archive depends on object + call add_dependency(targets(1)%ptr, targets(size(targets))%ptr) + end if + + !> Add stdc++ as a linker flag. If not already there. + if (.not. ("stdc++" .in. model%link_libraries)) then + model%link_libraries = [model%link_libraries, string_t("stdc++")] + end if case (FPM_UNIT_PROGRAM) @@ -725,10 +732,12 @@ subroutine resolve_target_linking(targets, model) do i=1,size(targets) associate(target => targets(i)%ptr) - if (target%target_type /= FPM_TARGET_C_OBJECT) then + if (target%target_type /= FPM_TARGET_C_OBJECT .and. target%target_type /= FPM_TARGET_CPP_OBJECT) then target%compile_flags = model%fortran_compile_flags - else + else if (target%target_type == FPM_TARGET_C_OBJECT) then target%compile_flags = model%c_compile_flags + else if(target%target_type == FPM_TARGET_CPP_OBJECT) then + target%compile_flags = model%cpp_compile_flags end if !> Get macros as flags. From 97810e54b9d1a75c3fa91a4e0b30bc3864e060dd Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Tue, 30 Aug 2022 07:23:15 +0100 Subject: [PATCH 12/18] Update: cpp example package to use cpp stdlib. (#2) Uses std:vector and std:algorithm to check that the cpp standard library is linked and called correctly. --- example_packages/cpp_files/src/cpp_files.f90 | 8 +++++--- example_packages/cpp_files/src/hello_world.cpp | 15 ++++++++++----- example_packages/cpp_files/test/check.f90 | 16 ++++++++++++++-- 3 files changed, 29 insertions(+), 10 deletions(-) diff --git a/example_packages/cpp_files/src/cpp_files.f90 b/example_packages/cpp_files/src/cpp_files.f90 index 445b2ea935..fc80e8fee2 100644 --- a/example_packages/cpp_files/src/cpp_files.f90 +++ b/example_packages/cpp_files/src/cpp_files.f90 @@ -3,10 +3,12 @@ module cpp_files implicit none private - public :: hello_world + public :: intvec_maxval interface - subroutine hello_world() bind(C, name = "hello_world") - end subroutine hello_world + integer function intvec_maxval(array, n) bind(C, name = "intvec_maxval") + integer, intent(in) :: array(*) + integer, intent(in), value :: n + end function intvec_maxval end interface end module cpp_files diff --git a/example_packages/cpp_files/src/hello_world.cpp b/example_packages/cpp_files/src/hello_world.cpp index a355c057b5..54720593f8 100644 --- a/example_packages/cpp_files/src/hello_world.cpp +++ b/example_packages/cpp_files/src/hello_world.cpp @@ -1,9 +1,14 @@ -#include +#include +#include extern "C" { - int hello_world(); -} -int hello_world() { - std::cout << "Hello World"; +int intvec_maxval(int* array, size_t n){ + + std::vector vec(array, array + n); + + return *(std::max_element(vec.begin(), vec.end())); + } + +} \ No newline at end of file diff --git a/example_packages/cpp_files/test/check.f90 b/example_packages/cpp_files/test/check.f90 index d7e3cba687..302510bfe7 100644 --- a/example_packages/cpp_files/test/check.f90 +++ b/example_packages/cpp_files/test/check.f90 @@ -1,5 +1,17 @@ program check -implicit none + use cpp_files + implicit none + + integer :: i, max_element + integer, parameter :: array(*) = [(i,i=-50,10)] + + max_element = intvec_maxval(array,size(array,1)) + + if (max_element == maxval(array)) then + write(*,*) ' PASSED: Max element is ',max_element + else + write(*,*) ' (!) FAILED: Incorrect max element returned' + stop 1 + end if -print *, "Put some tests in here!" end program check From e6c8f31451abf2e54dcba2ae872711d2994569a4 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Tue, 30 Aug 2022 09:32:52 +0100 Subject: [PATCH 13/18] Fix: C++ linking for MacOS. --- src/fpm_targets.f90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index c5c66f7375..a04265101a 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -27,7 +27,7 @@ module fpm_targets use iso_fortran_env, only: int64 use fpm_error, only: error_t, fatal_error, fpm_stop use fpm_model -use fpm_environment, only: get_os_type, OS_WINDOWS +use fpm_environment, only: get_os_type, OS_WINDOWS, OS_MACOS use fpm_filesystem, only: dirname, join_path, canon_path use fpm_strings, only: string_t, operator(.in.), string_cat, fnv_1a, resize use fpm_compiler, only: get_macros @@ -255,7 +255,13 @@ subroutine build_target_list(targets,model) !> Add stdc++ as a linker flag. If not already there. if (.not. ("stdc++" .in. model%link_libraries)) then - model%link_libraries = [model%link_libraries, string_t("stdc++")] + + if (get_os_type() == OS_MACOS) then + model%link_libraries = [model%link_libraries, string_t("c++")] + else + model%link_libraries = [model%link_libraries, string_t("stdc++")] + end if + end if case (FPM_UNIT_PROGRAM) From 24577d131fe133fe95982668c72aa9ae4003fe4a Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Tue, 30 Aug 2022 13:01:26 +0100 Subject: [PATCH 14/18] Update example_packages/cpp_files/src/cpp_files.f90 Co-authored-by: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> --- example_packages/cpp_files/src/cpp_files.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/example_packages/cpp_files/src/cpp_files.f90 b/example_packages/cpp_files/src/cpp_files.f90 index fc80e8fee2..818beb53a2 100644 --- a/example_packages/cpp_files/src/cpp_files.f90 +++ b/example_packages/cpp_files/src/cpp_files.f90 @@ -7,8 +7,9 @@ module cpp_files interface integer function intvec_maxval(array, n) bind(C, name = "intvec_maxval") - integer, intent(in) :: array(*) - integer, intent(in), value :: n + import :: c_int, c_size_t + integer(c_int), intent(in) :: array(*) + integer(c_size_t), intent(in), value :: n end function intvec_maxval end interface end module cpp_files From 0235f3f3ee5718d0527e39955555ed06d4b57219 Mon Sep 17 00:00:00 2001 From: Laurence Kedward Date: Tue, 30 Aug 2022 13:05:44 +0100 Subject: [PATCH 15/18] Fix: int type mismatch in cpp example package. --- example_packages/cpp_files/test/check.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/example_packages/cpp_files/test/check.f90 b/example_packages/cpp_files/test/check.f90 index 302510bfe7..2e5bd1ee84 100644 --- a/example_packages/cpp_files/test/check.f90 +++ b/example_packages/cpp_files/test/check.f90 @@ -1,11 +1,12 @@ program check + use iso_c_binding, only: c_size_t use cpp_files implicit none integer :: i, max_element integer, parameter :: array(*) = [(i,i=-50,10)] - max_element = intvec_maxval(array,size(array,1)) + max_element = intvec_maxval(array,size(array,1,c_size_t)) if (max_element == maxval(array)) then write(*,*) ' PASSED: Max element is ',max_element From de1590575b1d17d693b69e06b8fb4b21a92d2838 Mon Sep 17 00:00:00 2001 From: arteevraina Date: Wed, 31 Aug 2022 11:07:21 +0530 Subject: [PATCH 16/18] refactor: rename cpp_compiler to cxx_compiler --- src/fpm.f90 | 2 +- src/fpm_command_line.f90 | 14 +++++++------- src/fpm_compiler.f90 | 22 +++++++++++----------- 3 files changed, 19 insertions(+), 19 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 497cb6a036..c7340acde7 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -65,7 +65,7 @@ subroutine build_model(model, settings, package, error) end if call new_compiler(model%compiler, settings%compiler, settings%c_compiler, & - & settings%cpp_compiler, echo=settings%verbose, verbose=settings%verbose) + & settings%cxx_compiler, echo=settings%verbose, verbose=settings%verbose) call new_archiver(model%archiver, settings%archiver, & & echo=settings%verbose, verbose=settings%verbose) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 7401f54c76..826ac44acd 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -74,7 +74,7 @@ module fpm_command_line logical :: prune=.true. character(len=:),allocatable :: compiler character(len=:),allocatable :: c_compiler - character(len=:),allocatable :: cpp_compiler + character(len=:),allocatable :: cxx_compiler character(len=:),allocatable :: archiver character(len=:),allocatable :: profile character(len=:),allocatable :: flag @@ -199,7 +199,7 @@ subroutine get_command_line_settings(cmd_settings) logical :: unix type(fpm_install_settings), allocatable :: install_settings character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, & - & c_compiler, cpp_compiler, archiver + & c_compiler, cxx_compiler, archiver character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", & & fflags_env = "FFLAGS", cflags_env = "CFLAGS", cxxflags_env = "CXXFLAGS", ldflags_env = "LDFLAGS", & @@ -248,7 +248,7 @@ subroutine get_command_line_settings(cmd_settings) ' --no-prune F' // & ' --compiler "'//get_fpm_env(fc_env, fc_default)//'"' // & ' --c-compiler "'//get_fpm_env(cc_env, cc_default)//'"' // & - ' --cpp-compiler "'//get_fpm_env(cxx_env, cxx_default)//'"' // & + ' --cxx-compiler "'//get_fpm_env(cxx_env, cxx_default)//'"' // & ' --archiver "'//get_fpm_env(ar_env, ar_default)//'"' // & ' --flag:: "'//get_fpm_env(fflags_env, flags_default)//'"' // & ' --c-flag:: "'//get_fpm_env(cflags_env, flags_default)//'"' // & @@ -291,7 +291,7 @@ subroutine get_command_line_settings(cmd_settings) enddo c_compiler = sget('c-compiler') - cpp_compiler = sget('cpp-compiler') + cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') allocate(fpm_run_settings :: cmd_settings) val_runner=sget('runner') @@ -324,7 +324,7 @@ subroutine get_command_line_settings(cmd_settings) call check_build_vals() c_compiler = sget('c-compiler') - cpp_compiler = sget('cpp-compiler') + cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') allocate( fpm_build_settings :: cmd_settings ) cmd_settings=fpm_build_settings( & @@ -479,7 +479,7 @@ subroutine get_command_line_settings(cmd_settings) call check_build_vals() c_compiler = sget('c-compiler') - cpp_compiler = sget('cpp-compiler') + cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') allocate(install_settings) install_settings = fpm_install_settings(& @@ -534,7 +534,7 @@ subroutine get_command_line_settings(cmd_settings) enddo c_compiler = sget('c-compiler') - cpp_compiler = sget('cpp-compiler') + cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') allocate(fpm_test_settings :: cmd_settings) val_runner=sget('runner') diff --git a/src/fpm_compiler.f90 b/src/fpm_compiler.f90 index 8417f8c811..2060b7dd58 100644 --- a/src/fpm_compiler.f90 +++ b/src/fpm_compiler.f90 @@ -588,9 +588,9 @@ subroutine get_default_c_compiler(f_compiler, c_compiler) end subroutine get_default_c_compiler !> Get C++ Compiler. -subroutine get_default_cpp_compiler(f_compiler, cpp_compiler) +subroutine get_default_cxx_compiler(f_compiler, cxx_compiler) character(len=*), intent(in) :: f_compiler - character(len=:), allocatable, intent(out) :: cpp_compiler + character(len=:), allocatable, intent(out) :: cxx_compiler integer(compiler_enum) :: id id = get_compiler_id(f_compiler) @@ -598,29 +598,29 @@ subroutine get_default_cpp_compiler(f_compiler, cpp_compiler) select case(id) case(id_intel_classic_nix, id_intel_classic_mac, id_intel_classic_windows) - cpp_compiler = 'icpc' + cxx_compiler = 'icpc' case(id_intel_llvm_nix,id_intel_llvm_windows) - cpp_compiler = 'icpx' + cxx_compiler = 'icpx' case(id_flang, id_flang_new, id_f18) - cpp_compiler='clang' + cxx_compiler='clang' case(id_ibmxl) - cpp_compiler='xlc++' + cxx_compiler='xlc++' case(id_lfortran) - cpp_compiler = 'cc' + cxx_compiler = 'cc' case(id_gcc) - cpp_compiler = 'g++' + cxx_compiler = 'g++' case default ! Fall-back to using Fortran compiler - cpp_compiler = f_compiler + cxx_compiler = f_compiler end select -end subroutine get_default_cpp_compiler +end subroutine get_default_cxx_compiler function get_compiler_id(compiler) result(id) @@ -821,7 +821,7 @@ subroutine new_compiler(self, fc, cc, cxx, echo, verbose) if (len_trim(cxx) > 0) then self%cxx = cxx else - call get_default_cpp_compiler(self%fc, self%cxx) + call get_default_cxx_compiler(self%fc, self%cxx) end if end subroutine new_compiler From c83802d4e9d0198eb03c66be36ed40b49e15a482 Mon Sep 17 00:00:00 2001 From: arteevraina Date: Wed, 31 Aug 2022 11:10:41 +0530 Subject: [PATCH 17/18] refactor: added .hpp in c_suffixes list --- src/fpm_sources.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_sources.f90 b/src/fpm_sources.f90 index 5bb487f9f5..b821362c55 100644 --- a/src/fpm_sources.f90 +++ b/src/fpm_sources.f90 @@ -17,7 +17,7 @@ module fpm_sources character(4), parameter :: fortran_suffixes(2) = [".f90", & ".f "] -character(4), parameter :: c_suffixes(3) = [".c ", ".h ", ".cpp"] +character(4), parameter :: c_suffixes(4) = [".c ", ".h ", ".cpp", ".hpp"] contains From 294f71b2b6b957795ce9f518045fddb6b6d64a7a Mon Sep 17 00:00:00 2001 From: arteevraina Date: Wed, 31 Aug 2022 11:29:38 +0530 Subject: [PATCH 18/18] fix: set cxx compiler in fpm__settings and also renamed cpp to cxx at left out places --- src/fpm.f90 | 4 +++- src/fpm_command_line.f90 | 4 ++++ src/fpm_model.f90 | 4 ++-- src/fpm_targets.f90 | 2 +- 4 files changed, 10 insertions(+), 4 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index c7340acde7..3b49ca9544 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -94,7 +94,7 @@ subroutine build_model(model, settings, package, error) model%fortran_compile_flags = flags model%c_compile_flags = cflags - model%cpp_compile_flags = cxxflags + model%cxx_compile_flags = cxxflags model%link_flags = ldflags model%include_tests = settings%build_tests @@ -219,8 +219,10 @@ subroutine build_model(model, settings, package, error) write(*,*)' BUILD_NAME: ',model%build_prefix write(*,*)' COMPILER: ',model%compiler%fc write(*,*)' C COMPILER: ',model%compiler%cc + write(*,*)' CXX COMPILER: ',model%compiler%cxx write(*,*)' COMPILER OPTIONS: ', model%fortran_compile_flags write(*,*)' C COMPILER OPTIONS: ', model%c_compile_flags + write(*,*)' CXX COMPILER OPTIONS: ', model%cxx_compile_flags write(*,*)' LINKER OPTIONS: ', model%link_flags write(*,*)' INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']' end if diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 826ac44acd..6383246973 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -302,6 +302,7 @@ subroutine get_command_line_settings(cmd_settings) & prune=.not.lget('no-prune'), & & compiler=val_compiler, & & c_compiler=c_compiler, & + & cxx_compiler=cxx_compiler, & & archiver=archiver, & & flag=val_flag, & & cflag=val_cflag, & @@ -332,6 +333,7 @@ subroutine get_command_line_settings(cmd_settings) & prune=.not.lget('no-prune'), & & compiler=val_compiler, & & c_compiler=c_compiler, & + & cxx_compiler=cxx_compiler, & & archiver=archiver, & & flag=val_flag, & & cflag=val_cflag, & @@ -488,6 +490,7 @@ subroutine get_command_line_settings(cmd_settings) prune=.not.lget('no-prune'), & compiler=val_compiler, & c_compiler=c_compiler, & + cxx_compiler=cxx_compiler, & archiver=archiver, & flag=val_flag, & cflag=val_cflag, & @@ -545,6 +548,7 @@ subroutine get_command_line_settings(cmd_settings) & prune=.not.lget('no-prune'), & & compiler=val_compiler, & & c_compiler=c_compiler, & + & cxx_compiler=cxx_compiler, & & archiver=archiver, & & flag=val_flag, & & cflag=val_cflag, & diff --git a/src/fpm_model.f90 b/src/fpm_model.f90 index f1171c55bb..68d8e8ecf3 100644 --- a/src/fpm_model.f90 +++ b/src/fpm_model.f90 @@ -156,7 +156,7 @@ module fpm_model character(:), allocatable :: c_compile_flags !> Command line flags passed to C++ for compilation - character(:), allocatable :: cpp_compile_flags + character(:), allocatable :: cxx_compile_flags !> Command line flags passed to the linker character(:), allocatable :: link_flags @@ -322,7 +322,7 @@ function info_model(model) result(s) ! character(:), allocatable :: fortran_compile_flags s = s // ', fortran_compile_flags="' // model%fortran_compile_flags // '"' s = s // ', c_compile_flags="' // model%c_compile_flags // '"' - s = s // ', cpp_compile_flags="' // model%cpp_compile_flags // '"' + s = s // ', cxx_compile_flags="' // model%cxx_compile_flags // '"' s = s // ', link_flags="' // model%link_flags // '"' s = s // ', build_prefix="' // model%build_prefix // '"' ! type(string_t), allocatable :: link_libraries(:) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index a04265101a..8809795cf4 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -743,7 +743,7 @@ subroutine resolve_target_linking(targets, model) else if (target%target_type == FPM_TARGET_C_OBJECT) then target%compile_flags = model%c_compile_flags else if(target%target_type == FPM_TARGET_CPP_OBJECT) then - target%compile_flags = model%cpp_compile_flags + target%compile_flags = model%cxx_compile_flags end if !> Get macros as flags.