Skip to content

Commit 5d22f5a

Browse files
awvwgkawvwgk
committed
Add objects for handling compiler and archiver
1 parent 8ffe495 commit 5d22f5a

File tree

4 files changed

+205
-67
lines changed

4 files changed

+205
-67
lines changed

‎src/fpm.f90‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ module fpm
1010
FPM_SCOPE_UNKNOWN, FPM_SCOPE_LIB, FPM_SCOPE_DEP, &
1111
FPM_SCOPE_APP, FPM_SCOPE_EXAMPLE, FPM_SCOPE_TEST
1212
use fpm_compiler, only: get_module_flags, is_unknown_compiler, get_default_c_compiler, &
13-
get_archiver
13+
archiver_t
1414

1515

1616
use fpm_sources, only: add_executable_sources, add_sources_from_dir
@@ -59,23 +59,23 @@ subroutine build_model(model, settings, package, error)
5959
if (allocated(error)) return
6060

6161
if(settings%compiler.eq.'')then
62-
model%fortran_compiler = 'gfortran'
62+
model%compiler%fc = "gfortran"
6363
else
64-
model%fortran_compiler = settings%compiler
64+
model%compiler%fc = settings%compiler
6565
endif
6666

67-
model%archiver = get_archiver()
68-
call get_default_c_compiler(model%fortran_compiler, model%c_compiler)
69-
model%c_compiler = get_env('FPM_C_COMPILER',model%c_compiler)
67+
model%archiver = archiver_t()
68+
call get_default_c_compiler(model%compiler%fc, model%compiler%cc)
69+
model%compiler%cc = get_env('FPM_C_COMPILER',model%compiler%cc)
7070

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

78-
call get_module_flags(model%fortran_compiler, &
78+
call get_module_flags(model%compiler%fc, &
7979
& join_path(model%output_directory,model%package_name), &
8080
& model%fortran_compile_flags)
8181
model%fortran_compile_flags = settings%flag // model%fortran_compile_flags
@@ -187,8 +187,8 @@ subroutine build_model(model, settings, package, error)
187187

188188
if (settings%verbose) then
189189
write(*,*)'<INFO> BUILD_NAME: ',settings%build_name
190-
write(*,*)'<INFO> COMPILER: ',settings%compiler
191-
write(*,*)'<INFO> C COMPILER: ',model%c_compiler
190+
write(*,*)'<INFO> COMPILER: ',model%compiler%fc
191+
write(*,*)'<INFO> C COMPILER: ',model%compiler%cc
192192
write(*,*)'<INFO> COMPILER OPTIONS: ', model%fortran_compile_flags
193193
write(*,*)'<INFO> INCLUDE DIRECTORIES: [', string_cat(model%include_dirs,','),']'
194194
end if

‎src/fpm_backend.f90‎

Lines changed: 8 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -30,12 +30,10 @@ module fpm_backend
3030
use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
3131
use fpm_error, only : fpm_stop
3232
use fpm_environment, only: run, get_os_type, OS_WINDOWS
33-
use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir, unix_path
33+
use fpm_filesystem, only: basename, dirname, join_path, exists, mkdir
3434
use fpm_model, only: fpm_model_t
3535
use fpm_targets, only: build_target_t, build_target_ptr, FPM_TARGET_OBJECT, &
3636
FPM_TARGET_C_OBJECT, FPM_TARGET_ARCHIVE, FPM_TARGET_EXECUTABLE
37-
use fpm_strings, only: string_cat, string_t
38-
3937
implicit none
4038

4139
private
@@ -265,31 +263,19 @@ subroutine build_target(model,target,stat)
265263
select case(target%target_type)
266264

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

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

275273
case (FPM_TARGET_EXECUTABLE)
276-
277-
call run(model%fortran_compiler// " " // target%compile_flags &
278-
//" "//target%link_flags// " -o " // target%output_file, echo=.true., exitstat=stat)
274+
call model%compiler%link(target%output_file, &
275+
& target%compile_flags//" "//target%link_flags, stat)
279276

280277
case (FPM_TARGET_ARCHIVE)
281-
282-
select case (get_os_type())
283-
case (OS_WINDOWS)
284-
call write_response_file(target%output_file//".resp" ,target%link_objects)
285-
call run(model%archiver // target%output_file // " @" // target%output_file//".resp", &
286-
echo=.true., exitstat=stat)
287-
288-
case default
289-
call run(model%archiver // target%output_file // " " // string_cat(target%link_objects," "), &
290-
echo=.true., exitstat=stat)
291-
292-
end select
278+
call model%archiver%make_archive(target%output_file, target%link_objects, stat)
293279

294280
end select
295281

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

302288
end subroutine build_target
303289

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

319291
end module fpm_backend

‎src/fpm_compiler.f90‎

Lines changed: 177 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -26,9 +26,8 @@
2626
! Open64 ? ? -module -I -mp discontinued
2727
! Unisys ? ? ? ? ? discontinued
2828
module fpm_compiler
29-
use fpm_model, only: fpm_model_t
30-
use fpm_filesystem, only: join_path, basename, get_temp_filename
3129
use fpm_environment, only: &
30+
run, &
3231
get_os_type, &
3332
OS_LINUX, &
3433
OS_MACOS, &
@@ -38,13 +37,17 @@ module fpm_compiler
3837
OS_FREEBSD, &
3938
OS_OPENBSD, &
4039
OS_UNKNOWN
40+
use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path
41+
use fpm_strings, only: string_cat, string_t
4142
implicit none
4243
public :: is_unknown_compiler
4344
public :: get_module_flags
4445
public :: get_default_compile_flags
4546
public :: get_debug_compile_flags
4647
public :: get_release_compile_flags
47-
public :: get_archiver
48+
49+
public :: compiler_t, archiver_t
50+
public :: debug
4851

4952
enum, bind(C)
5053
enumerator :: &
@@ -70,6 +73,52 @@ module fpm_compiler
7073
end enum
7174
integer, parameter :: compiler_enum = kind(id_unknown)
7275

76+
77+
!> Definition of compiler object
78+
type :: compiler_t
79+
!> Path to the Fortran compiler
80+
character(len=:), allocatable :: fc
81+
!> Path to the C compiler
82+
character(len=:), allocatable :: cc
83+
!> Print all commands
84+
logical :: echo = .true.
85+
contains
86+
!> Compile a Fortran object
87+
procedure :: compile_fortran
88+
!> Compile a C object
89+
procedure :: compile_c
90+
!> Link executable
91+
procedure :: link
92+
end type compiler_t
93+
94+
95+
!> Definition of archiver object
96+
type :: archiver_t
97+
!> Path to archiver
98+
character(len=:), allocatable :: ar
99+
!> Use response files to pass arguments
100+
logical :: use_response_file = .false.
101+
!> Print all command
102+
logical :: echo = .true.
103+
contains
104+
!> Create static archive
105+
procedure :: make_archive
106+
end type archiver_t
107+
108+
109+
!> Constructor for archiver
110+
interface archiver_t
111+
module procedure :: new_archiver
112+
end interface archiver_t
113+
114+
115+
!> Create debug printout
116+
interface debug
117+
module procedure :: debug_compiler
118+
module procedure :: debug_archiver
119+
end interface debug
120+
121+
73122
contains
74123

75124
subroutine get_default_compile_flags(compiler, release, flags)
@@ -460,29 +509,148 @@ function check_compiler(compiler, expected) result(match)
460509
end if
461510
end function check_compiler
462511

512+
463513
function is_unknown_compiler(compiler) result(is_unknown)
464514
character(len=*), intent(in) :: compiler
465515
logical :: is_unknown
466516
is_unknown = get_compiler_id(compiler) == id_unknown
467517
end function is_unknown_compiler
468518

469519

470-
function get_archiver() result(archiver)
471-
character(:), allocatable :: archiver
520+
!> Create new archiver
521+
function new_archiver() result(self)
522+
!> New instance of the archiver
523+
type(archiver_t) :: self
472524
integer :: estat, os_type
473525

474526
os_type = get_os_type()
475527
if (os_type /= OS_WINDOWS .and. os_type /= OS_UNKNOWN) then
476-
archiver = "ar -rs "
528+
self%ar = "ar -rs "
477529
else
478530
call execute_command_line("ar --version > "//get_temp_filename()//" 2>&1", &
479531
& exitstat=estat)
480532
if (estat /= 0) then
481-
archiver = "lib /OUT:"
533+
self%ar = "lib /OUT:"
482534
else
483-
archiver = "ar -rs "
535+
self%ar = "ar -rs "
484536
end if
485537
end if
486-
end function
538+
self%use_response_file = os_type == OS_WINDOWS
539+
self%echo = .true.
540+
end function new_archiver
541+
542+
543+
!> Compile a Fortran object
544+
subroutine compile_fortran(self, input, output, args, stat)
545+
!> Instance of the compiler object
546+
class(compiler_t), intent(in) :: self
547+
!> Source file input
548+
character(len=*), intent(in) :: input
549+
!> Output file of object
550+
character(len=*), intent(in) :: output
551+
!> Arguments for compiler
552+
character(len=*), intent(in) :: args
553+
!> Status flag
554+
integer, intent(out) :: stat
555+
556+
call run(self%fc // " -c " // input // " " // args // " -o " // output, &
557+
& echo=self%echo, exitstat=stat)
558+
end subroutine compile_fortran
559+
560+
561+
!> Compile a C object
562+
subroutine compile_c(self, input, output, args, stat)
563+
!> Instance of the compiler object
564+
class(compiler_t), intent(in) :: self
565+
!> Source file input
566+
character(len=*), intent(in) :: input
567+
!> Output file of object
568+
character(len=*), intent(in) :: output
569+
!> Arguments for compiler
570+
character(len=*), intent(in) :: args
571+
!> Status flag
572+
integer, intent(out) :: stat
573+
574+
call run(self%cc // " -c " // input // " " // args // " -o " // output, &
575+
& echo=self%echo, exitstat=stat)
576+
end subroutine compile_c
577+
578+
579+
!> Link an executable
580+
subroutine link(self, output, args, stat)
581+
!> Instance of the compiler object
582+
class(compiler_t), intent(in) :: self
583+
!> Output file of object
584+
character(len=*), intent(in) :: output
585+
!> Arguments for compiler
586+
character(len=*), intent(in) :: args
587+
!> Status flag
588+
integer, intent(out) :: stat
589+
590+
call run(self%fc // " " // args // " -o " // output, echo=self%echo, exitstat=stat)
591+
end subroutine link
592+
593+
594+
!> Create an archive
595+
subroutine make_archive(self, output, args, stat)
596+
!> Instance of the archiver object
597+
class(archiver_t), intent(in) :: self
598+
!> Name of the archive to generate
599+
character(len=*), intent(in) :: output
600+
!> Object files to include into the archive
601+
type(string_t), intent(in) :: args(:)
602+
!> Status flag
603+
integer, intent(out) :: stat
604+
605+
if (self%use_response_file) then
606+
call write_response_file(output//".resp" , args)
607+
call run(self%ar // output // " @" // output//".resp", echo=self%echo, exitstat=stat)
608+
call delete_file(output//".resp")
609+
else
610+
call run(self%ar // output // " " // string_cat(args, " "), &
611+
& echo=self%echo, exitstat=stat)
612+
end if
613+
end subroutine make_archive
614+
615+
616+
!> Response files allow to read command line options from files.
617+
!> Whitespace is used to separate the arguments, we will use newlines
618+
!> as separator to create readable response files which can be inspected
619+
!> in case of errors.
620+
subroutine write_response_file(name, argv)
621+
character(len=*), intent(in) :: name
622+
type(string_t), intent(in) :: argv(:)
623+
624+
integer :: iarg, io
625+
626+
open(file=name, newunit=io)
627+
do iarg = 1, size(argv)
628+
write(io, '(a)') unix_path(argv(iarg)%s)
629+
end do
630+
close(io)
631+
end subroutine write_response_file
632+
633+
634+
!> String representation of a compiler object
635+
pure function debug_compiler(self) result(repr)
636+
!> Instance of the compiler object
637+
type(compiler_t), intent(in) :: self
638+
!> Representation as string
639+
character(len=:), allocatable :: repr
640+
641+
repr = 'fc="'//self%fc//'", cc="'//self%cc//'"'
642+
end function debug_compiler
643+
644+
645+
!> String representation of an archiver object
646+
pure function debug_archiver(self) result(repr)
647+
!> Instance of the archiver object
648+
type(archiver_t), intent(in) :: self
649+
!> Representation as string
650+
character(len=:), allocatable :: repr
651+
652+
repr = 'ar="'//self%ar//'"'
653+
end function debug_archiver
654+
487655

488656
end module fpm_compiler

0 commit comments

Comments
 (0)