Skip to content

Commit

Permalink
Add objects for handling compiler and archiver
Browse files Browse the repository at this point in the history
  • Loading branch information
@awvwgk
awvwgk committed Jul 30, 2021
1 parent 8ffe495 commit 5d22f5a
Show file tree
Hide file tree
Showing 4 changed files with 205 additions and 67 deletions.
24 changes: 12 additions & 12 deletions src/fpm.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ module fpm
FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, &
FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST
use fpm_compiler, only: get_module_flags, is_unknown_compiler, get_default_c_compiler, &
get_archiver
archiver_t


use fpm_sources, only: add_executable_sources, add_sources_from_dir
Expand Down Expand Up @@ -59,23 +59,23 @@ subroutine build_model(model, settings, package, error)
if (allocated(error)) return

if(settings%compiler.eq.'')then
model%fortran_compiler = 'gfortran'
model%compiler%fc = "gfortran"
else
model%fortran_compiler = settings%compiler
model%compiler%fc = settings%compiler
endif

model%archiver = get_archiver()
call get_default_c_compiler(model%fortran_compiler, model%c_compiler)
model%c_compiler = get_env('FPM_C_COMPILER',model%c_compiler)
model%archiver = archiver_t()
call get_default_c_compiler(model%compiler%fc, model%compiler%cc)
model%compiler%cc = get_env('FPM_C_COMPILER',model%compiler%cc)

if (is_unknown_compiler(model%fortran_compiler)) then
if (is_unknown_compiler(model%compiler%fc)) then
write(*, '(*(a:,1x))') &
"<WARN>", "Unknown compiler", model%fortran_compiler, "requested!", &
"<WARN>", "Unknown compiler", model%compiler%fc, "requested!", &
"Defaults for this compiler might be incorrect"
end if
model%output_directory = join_path('build',basename(model%fortran_compiler)//'_'//settings%build_name)
model%output_directory = join_path('build',basename(model%compiler%fc)//'_'//settings%build_name)

call get_module_flags(model%fortran_compiler, &
call get_module_flags(model%compiler%fc, &
& join_path(model%output_directory,model%package_name), &
& model%fortran_compile_flags)
model%fortran_compile_flags = settings%flag // model%fortran_compile_flags
Expand Down Expand Up @@ -187,8 +187,8 @@ subroutine build_model(model, settings, package, error)

if (settings%verbose) then
write(*,*)'<INFO> BUILD_NAME: ',settings%build_name
write(*,*)'<INFO> COMPILER: ',settings%compiler
write(*,*)'<INFO> C COMPILER: ',model%c_compiler
write(*,*)'<INFO> COMPILER: ',model%compiler%fc
write(*,*)'<INFO> C COMPILER: ',model%compiler%cc
write(*,*)'<INFO> COMPILER OPTIONS: ', model%fortran_compile_flags
write(*,*)'<INFO> INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']'
end if
Expand Down
44 changes: 8 additions & 36 deletions src/fpm_backend.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,12 +30,10 @@ module fpm_backend
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
use fpm_error, only : fpm_stop
use fpm_environment, only: run, get_os_type, OS_WINDOWS
use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir, unix_path
use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir
use fpm_model, only: fpm_model_t
use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, &
FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE
use fpm_strings, only: string_cat, string_t

implicit none

private
Expand Down Expand Up @@ -265,31 +263,19 @@ subroutine build_target(model,target,stat)
select case(target%target_type)

case (FPM_TARGET_OBJECT)
call run(model%fortran_compiler//" -c " // target%source%file_name // target%compile_flags &
// " -o " // target%output_file, echo=.true., exitstat=stat)
call model%compiler%compile_fortran(target%source%file_name, target%output_file, &
& target%compile_flags, stat)

case (FPM_TARGET_C_OBJECT)
call run(model%c_compiler//" -c " // target%source%file_name // target%compile_flags &
// " -o " // target%output_file, echo=.true., exitstat=stat)
call model%compiler%compile_c(target%source%file_name, target%output_file, &
& target%compile_flags, stat)

case (FPM_TARGET_EXECUTABLE)

call run(model%fortran_compiler// " " // target%compile_flags &
//" "//target%link_flags// " -o " // target%output_file, echo=.true., exitstat=stat)
call model%compiler%link(target%output_file, &
& target%compile_flags//" "//target%link_flags, stat)

case (FPM_TARGET_ARCHIVE)

select case (get_os_type())
case (OS_WINDOWS)
call write_response_file(target%output_file//".resp" ,target%link_objects)
call run(model%archiver // target%output_file // " @" // target%output_file//".resp", &
echo=.true., exitstat=stat)

case default
call run(model%archiver // target%output_file // " " // string_cat(target%link_objects," "), &
echo=.true., exitstat=stat)

end select
call model%archiver%make_archive(target%output_file, target%link_objects, stat)

end select

Expand All @@ -301,19 +287,5 @@ subroutine build_target(model,target,stat)

end subroutine build_target

!> Response files allow to read command line options from files.
!> Whitespace is used to separate the arguments, we will use newlines
!> as separator to create readable response files which can be inspected
!> in case of errors.
subroutine write_response_file(name, argv)
character(len=*), intent(in) :: name
type(string_t), intent(in) :: argv(:)
integer :: iarg, io
open(file=name, newunit=io)
do iarg = 1, size(argv)
write(io, '(a)') unix_path(argv(iarg)%s)
end do
close(io)
end subroutine write_response_file

end module fpm_backend
186 changes: 177 additions & 9 deletions src/fpm_compiler.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,9 +26,8 @@
! Open64 ? ? -module -I -mp discontinued
! Unisys ? ? ? ? ? discontinued
module fpm_compiler
use fpm_model, only: fpm_model_t
use fpm_filesystem, only: join_path, basename, get_temp_filename
use fpm_environment, only: &
run, &
get_os_type, &
OS_LINUX, &
OS_MACOS, &
Expand All @@ -38,13 +37,17 @@ module fpm_compiler
OS_FREEBSD, &
OS_OPENBSD, &
OS_UNKNOWN
use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path
use fpm_strings, only: string_cat, string_t
implicit none
public :: is_unknown_compiler
public :: get_module_flags
public :: get_default_compile_flags
public :: get_debug_compile_flags
public :: get_release_compile_flags
public :: get_archiver

public :: compiler_t, archiver_t
public :: debug

enum, bind(C)
enumerator :: &
Expand All @@ -70,6 +73,52 @@ module fpm_compiler
end enum
integer, parameter :: compiler_enum = kind(id_unknown)


!> Definition of compiler object
type :: compiler_t
!> Path to the Fortran compiler
character(len=:), allocatable :: fc
!> Path to the C compiler
character(len=:), allocatable :: cc
!> Print all commands
logical :: echo = .true.
contains
!> Compile a Fortran object
procedure :: compile_fortran
!> Compile a C object
procedure :: compile_c
!> Link executable
procedure :: link
end type compiler_t


!> Definition of archiver object
type :: archiver_t
!> Path to archiver
character(len=:), allocatable :: ar
!> Use response files to pass arguments
logical :: use_response_file = .false.
!> Print all command
logical :: echo = .true.
contains
!> Create static archive
procedure :: make_archive
end type archiver_t


!> Constructor for archiver
interface archiver_t
module procedure :: new_archiver
end interface archiver_t


!> Create debug printout
interface debug
module procedure :: debug_compiler
module procedure :: debug_archiver
end interface debug


contains

subroutine get_default_compile_flags(compiler, release, flags)
Expand Down Expand Up @@ -460,29 +509,148 @@ function check_compiler(compiler, expected) result(match)
end if
end function check_compiler


function is_unknown_compiler(compiler) result(is_unknown)
character(len=*), intent(in) :: compiler
logical :: is_unknown
is_unknown = get_compiler_id(compiler) == id_unknown
end function is_unknown_compiler


function get_archiver() result(archiver)
character(:), allocatable :: archiver
!> Create new archiver
function new_archiver() result(self)
!> New instance of the archiver
type(archiver_t) :: self
integer :: estat, os_type

os_type = get_os_type()
if (os_type /= OS_WINDOWS .and. os_type /= OS_UNKNOWN) then
archiver = "ar -rs "
self%ar = "ar -rs "
else
call execute_command_line("ar --version > "//get_temp_filename()//" 2>&1", &
& exitstat=estat)
if (estat /= 0) then
archiver = "lib /OUT:"
self%ar = "lib /OUT:"
else
archiver = "ar -rs "
self%ar = "ar -rs "
end if
end if
end function
self%use_response_file = os_type == OS_WINDOWS
self%echo = .true.
end function new_archiver


!> Compile a Fortran object
subroutine compile_fortran(self, input, output, args, 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
!> Status flag
integer, intent(out) :: stat

call run(self%fc // " -c " // input // " " // args // " -o " // output, &
& echo=self%echo, exitstat=stat)
end subroutine compile_fortran


!> Compile a C object
subroutine compile_c(self, input, output, args, 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
!> Status flag
integer, intent(out) :: stat

call run(self%cc // " -c " // input // " " // args // " -o " // output, &
& echo=self%echo, exitstat=stat)
end subroutine compile_c


!> Link an executable
subroutine link(self, output, args, stat)
!> Instance of the compiler object
class(compiler_t), intent(in) :: self
!> Output file of object
character(len=*), intent(in) :: output
!> Arguments for compiler
character(len=*), intent(in) :: args
!> Status flag
integer, intent(out) :: stat

call run(self%fc // " " // args // " -o " // output, echo=self%echo, exitstat=stat)
end subroutine link


!> Create an archive
subroutine make_archive(self, output, args, stat)
!> Instance of the archiver object
class(archiver_t), intent(in) :: self
!> Name of the archive to generate
character(len=*), intent(in) :: output
!> Object files to include into the archive
type(string_t), intent(in) :: args(:)
!> Status flag
integer, intent(out) :: stat

if (self%use_response_file) then
call write_response_file(output//".resp" , args)
call run(self%ar // output // " @" // output//".resp", echo=self%echo, exitstat=stat)
call delete_file(output//".resp")
else
call run(self%ar // output // " " // string_cat(args, " "), &
& echo=self%echo, exitstat=stat)
end if
end subroutine make_archive


!> Response files allow to read command line options from files.
!> Whitespace is used to separate the arguments, we will use newlines
!> as separator to create readable response files which can be inspected
!> in case of errors.
subroutine write_response_file(name, argv)
character(len=*), intent(in) :: name
type(string_t), intent(in) :: argv(:)

integer :: iarg, io

open(file=name, newunit=io)
do iarg = 1, size(argv)
write(io, '(a)') unix_path(argv(iarg)%s)
end do
close(io)
end subroutine write_response_file


!> String representation of a compiler object
pure function debug_compiler(self) result(repr)
!> Instance of the compiler object
type(compiler_t), intent(in) :: self
!> Representation as string
character(len=:), allocatable :: repr

repr = 'fc="'//self%fc//'", cc="'//self%cc//'"'
end function debug_compiler


!> String representation of an archiver object
pure function debug_archiver(self) result(repr)
!> Instance of the archiver object
type(archiver_t), intent(in) :: self
!> Representation as string
character(len=:), allocatable :: repr

repr = 'ar="'//self%ar//'"'
end function debug_archiver


end module fpm_compiler
Loading

0 comments on commit 5d22f5a

Please sign in to comment.