Compile a C object
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
class(compiler_t), | intent(in) | :: | self |
Instance of the compiler object |
||
character(len=*), | intent(in) | :: | input |
Source file input |
||
character(len=*), | intent(in) | :: | output |
Output file of object |
||
character(len=*), | intent(in) | :: | args |
Arguments for compiler |
||
character(len=*), | intent(in) | :: | log_file |
Compiler output log file |
||
integer, | intent(out) | :: | stat |
Status flag |
||
type(compile_command_table_t), | intent(inout), | optional | :: | table |
Optional compile_commands table |
|
logical, | intent(in), | optional | :: | dry_run |
Optional mocking |
Type | Visibility | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|---|
character(len=:), | public, | allocatable | :: | command | |||
type(error_t), | public, | allocatable | :: | error | |||
logical, | public | :: | mock |
subroutine compile_c(self, input, output, args, log_file, stat, table, dry_run) !> 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 !> Optional compile_commands table type(compile_command_table_t), optional, intent(inout) :: table !> Optional mocking logical, optional, intent(in) :: dry_run character(len=:), allocatable :: command type(error_t), allocatable :: error logical :: mock ! Check if we're actually building this file mock = .false. if (present(dry_run)) mock = dry_run ! Set command command = self%cc // " -c " // input // " " // args // " -o " // output ! Execute command if (.not.mock) then call run(command, echo=self%echo, verbose=self%verbose, redirect=log_file, exitstat=stat) if (stat/=0) return endif ! Optionally register compile command if (present(table)) then call table%register(command, get_os_type(), error) stat = merge(-1,0,allocated(error)) endif end subroutine compile_c