Merge branch 'main' into backend-output

Author: LKedward

ci/run_tests.sh

@@ -98,5 +98,9 @@ pushd c_header_only
 "$fpm" build
 popd
 
+pushd c_main
+"$fpm" run
+popd
+
 # Cleanup
 rm -rf ./*/build

example_packages/c_main/app/main.c

@@ -0,0 +1,5 @@
+int
+main (void)
+{
+  return 0;
+}

example_packages/c_main/fpm.toml

@@ -0,0 +1,5 @@
+name = "c-main"
+
+[[executable]]
+name = "c-main"
+main = "main.c"

src/fpm/cmd/new.f90

@@ -56,9 +56,10 @@ module fpm_cmd_new
 use fpm_command_line, only : fpm_new_settings
 use fpm_environment, only : OS_LINUX, OS_MACOS, OS_WINDOWS
 use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir
-use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite, run
+use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite, which, run
 use fpm_strings, only : join, to_fortran_name
 use fpm_error, only : fpm_stop
+
 use,intrinsic :: iso_fortran_env, only : stderr=>error_unit
 implicit none
 private
@@ -572,9 +573,58 @@ subroutine cmd_new(settings)
         call create_verified_basic_manifest(join_path(settings%name, 'fpm.toml'))
     endif
     ! assumes git(1) is installed and in path
-    call run('git init ' // settings%name)
+    if(which('git').ne.'')then
+      call run('git init ' // settings%name)
+    endif
 contains
 
+function git_metadata(what) result(returned)
+!> get metadata values such as email address and git name from git(1) or return appropriate default
+  use fpm_filesystem, only : get_temp_filename, getline
+  character(len=*), intent(in)  :: what     ! keyword designating what git metatdata to query
+  character(len=:), allocatable :: returned ! value to return for requested keyword
+  character(len=:), allocatable :: command
+  character(len=:), allocatable :: temp_filename
+  character(len=:), allocatable :: iomsg
+  character(len=:), allocatable :: temp_value
+  integer :: stat, unit
+  temp_filename = get_temp_filename()
+  ! for known keywords set default value for RETURNED and associated git(1) command for query
+  select case(what)
+  case('uname')
+    returned = "Jane Doe"
+    command = "git config --get user.name > " // temp_filename
+  case('email')
+    returned = "[email protected]"
+    command = "git config --get user.email > " // temp_filename
+  case default
+    write(stderr,'(*(g0,1x))')&
+    & '<ERROR> *git_metadata* unknown metadata name ',trim(what)
+    returned=''
+    return
+  end select
+  ! Execute command if git(1) is in command path
+  if(which('git')/='')then
+     call run(command, exitstat=stat)
+     if (stat /= 0) then ! If command failed just return default
+        return
+     else ! Command did not return an error so try to read expected output file
+        open(file=temp_filename, newunit=unit,iostat=stat)
+        if(stat == 0)then
+           ! Read file into a scratch variable until status of doing so is checked
+           call getline(unit, temp_value, stat, iomsg)
+           if (stat == 0 .and. temp_value /= '') then
+              ! Return output from successful command
+              returned=temp_value
+           endif
+        endif
+        ! Always do the CLOSE because a failed open has unpredictable results.
+        ! Add IOSTAT so a failed close does not cause program to stop
+        close(unit, status="delete",iostat=stat)
+     endif
+  endif
+end function git_metadata
+
 subroutine create_verified_basic_manifest(filename)
 !> create a basic but verified default manifest file
 use fpm_toml, only : toml_table, toml_serializer, set_value
@@ -603,9 +653,9 @@ subroutine create_verified_basic_manifest(filename)
     call set_value(table, "name",       BNAME)
     call set_value(table, "version",    "0.1.0")
     call set_value(table, "license",    "license")
-    call set_value(table, "author",     "Jane Doe")
-    call set_value(table, "maintainer", "[email protected]")
-    call set_value(table, "copyright",  'Copyright '//date(1:4)//', Jane Doe')
+    call set_value(table, "author",     git_metadata('uname'))
+    call set_value(table, "maintainer", git_metadata('email'))
+    call set_value(table, "copyright",  'Copyright '//date(1:4)//', '//git_metadata('uname'))
     ! continue building of manifest
     ! ...
     call new_package(package, table, error=error)

src/fpm_command_line.f90

@@ -31,10 +31,12 @@ module fpm_command_line
 use fpm_strings,      only : lower, split, fnv_1a, to_fortran_name, is_fortran_name
 use fpm_filesystem,   only : basename, canon_path, which, run
 use fpm_environment,  only : get_command_arguments_quoted
-use fpm_error,        only : fpm_stop
+use fpm_error,        only : fpm_stop, error_t
+use fpm_os,           only : get_current_directory
 use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, &
                                        & stdout=>output_unit, &
                                        & stderr=>error_unit
+
 implicit none
 
 private
@@ -179,6 +181,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 = " "
+        type(error_t), allocatable :: error
 
         call set_help()
         ! text for --version switch,
@@ -317,9 +320,13 @@ subroutine get_command_line_settings(cmd_settings)
             & help_new, version_text)
             select case(size(unnamed))
             case(1)
-                write(stderr,'(*(7x,g0,/))') &
-                & '<USAGE> fpm new NAME [[--lib|--src] [--app] [--test] [--example]]|[--full|--bare] [--backfill]'
-                call fpm_stop(1,'directory name required')
+                if(lget('backfill'))then
+                   name='.'   
+                else
+                   write(stderr,'(*(7x,g0,/))') &
+                   & '<USAGE> fpm new NAME [[--lib|--src] [--app] [--test] [--example]]|[--full|--bare] [--backfill]'
+                   call fpm_stop(1,'directory name required')
+                endif
             case(2)
                 name=trim(unnamed(2))
             case default
@@ -328,6 +335,13 @@ subroutine get_command_line_settings(cmd_settings)
                 call fpm_stop(2,'only one directory name allowed')
             end select
             !*! canon_path is not converting ".", etc.
+            if(name.eq.'.')then
+               call get_current_directory(name, error)
+               if (allocated(error)) then
+                  write(stderr, '("[Error]", 1x, a)') error%message
+                  stop 1
+               endif
+            endif
             name=canon_path(name)
             if( .not.is_fortran_name(to_fortran_name(basename(name))) )then
                 write(stderr,'(g0)') [ character(len=72) :: &
@@ -336,6 +350,7 @@ subroutine get_command_line_settings(cmd_settings)
                 call fpm_stop(4,' ')
             endif
 
+
             allocate(fpm_new_settings :: cmd_settings)
             if (any( specified([character(len=10) :: 'src','lib','app','test','example','bare'])) &
             & .and.lget('full') )then
@@ -1079,7 +1094,7 @@ subroutine set_help()
     '   fpm new A --full # create example/ and an annotated fpm.toml as well', &
     '   fpm new A --bare # create no directories                            ', &
     '   create any missing files in current directory                       ', &
-    '   fpm new `pwd` --full --backfill                                     ', &
+    '   fpm new --full --backfill                                           ', &
     '' ]
     help_test=[character(len=80) :: &
     'NAME                                                                   ', &

src/fpm_compiler.f90

@@ -39,7 +39,7 @@ module fpm_compiler
         OS_UNKNOWN
 use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path, &
     & getline, run
-use fpm_strings, only: string_cat, string_t
+use fpm_strings, only: split, string_cat, string_t
 implicit none
 public :: compiler_t, new_compiler, archiver_t, new_archiver
 public :: debug
@@ -60,6 +60,8 @@ module fpm_compiler
         id_nvhpc, &
         id_nag, &
         id_flang, &
+        id_flang_new, &
+        id_f18, &
         id_ibmxl, &
         id_cray, &
         id_lahey, &
@@ -383,7 +385,8 @@ function get_include_flag(self, path) result(flags)
     case default
         flags = "-I "//path
 
-    case(id_caf, id_gcc, id_f95, id_cray, id_nvhpc, id_pgi, id_flang, &
+    case(id_caf, id_gcc, id_f95, id_cray, id_nvhpc, id_pgi, &
+        & id_flang, id_flang_new, id_f18, &
         & id_intel_classic_nix, id_intel_classic_mac, &
         & id_intel_llvm_nix, id_lahey, id_nag, id_ibmxl, &
         & id_lfortran)
@@ -410,6 +413,9 @@ function get_module_flag(self, path) result(flags)
     case(id_nvhpc, id_pgi, id_flang)
         flags = "-module "//path
 
+    case(id_flang_new, id_f18)
+        flags = "-module-dir "//path
+
     case(id_intel_classic_nix, id_intel_classic_mac, &
         & id_intel_llvm_nix)
         flags = "-module "//path
@@ -446,7 +452,7 @@ subroutine get_default_c_compiler(f_compiler, c_compiler)
     case(id_intel_llvm_nix,id_intel_llvm_windows)
         c_compiler = 'icx'
 
-    case(id_flang)
+    case(id_flang, id_flang_new, id_f18)
         c_compiler='clang'
 
     case(id_ibmxl)
@@ -470,22 +476,26 @@ function get_compiler_id(compiler) result(id)
     character(len=*), intent(in) :: compiler
     integer(kind=compiler_enum) :: id
 
-    character(len=:), allocatable :: command, output
+    character(len=:), allocatable :: full_command, full_command_parts(:), command, output
     integer :: stat, io
 
     ! Check whether we are dealing with an MPI compiler wrapper first
     if (check_compiler(compiler, "mpifort") &
         & .or. check_compiler(compiler, "mpif90") &
         & .or. check_compiler(compiler, "mpif77")) then
         output = get_temp_filename()
-        call run(compiler//" -showme:command > "//output//" 2>&1", &
+        call run(compiler//" -show > "//output//" 2>&1", &
             & echo=.false., exitstat=stat)
         if (stat == 0) then
             open(file=output, newunit=io, iostat=stat)
-            if (stat == 0) call getline(io, command, stat)
+            if (stat == 0) call getline(io, full_command, stat)
             close(io, iostat=stat)
 
             ! If we get a command from the wrapper, we will try to identify it
+            call split(full_command, full_command_parts, delimiters=' ')
+            if(size(full_command_parts) > 0)then
+               command = trim(full_command_parts(1))
+            endif
             if (allocated(command)) then
                 id = get_id(command)
                 if (id /= id_unknown) return
@@ -557,6 +567,16 @@ function get_id(compiler) result(id)
         return
     end if
 
+    if (check_compiler(compiler, "flang-new")) then
+        id = id_flang_new
+        return
+    end if
+
+    if (check_compiler(compiler, "f18")) then
+        id = id_f18
+        return
+    end if
+
     if (check_compiler(compiler, "flang")) then
         id = id_flang
         return

src/fpm_sources.f90

@@ -163,19 +163,23 @@ subroutine add_executable_sources(sources,executables,scope,auto_discover,error)
                 if (allocated(executables(i)%link)) then
                     sources(j)%link_libraries = executables(i)%link
                 end if
+                sources(j)%unit_type = FPM_UNIT_PROGRAM
                 cycle exe_loop
 
             end if
 
         end do
 
         ! Add if not already discovered (auto_discovery off)
-        exe_source = parse_source(join_path(executables(i)%source_dir,executables(i)%main),error)
-        exe_source%exe_name = executables(i)%name
-        if (allocated(executables(i)%link)) then
-            exe_source%link_libraries = executables(i)%link
-        end if
-        exe_source%unit_scope = scope
+        associate(exe => executables(i))
+            exe_source = parse_source(join_path(exe%source_dir,exe%main),error)
+            exe_source%exe_name = exe%name
+            if (allocated(exe%link)) then
+                exe_source%link_libraries = exe%link
+            end if
+            exe_source%unit_type = FPM_UNIT_PROGRAM
+            exe_source%unit_scope = scope
+        end associate
 
         if (allocated(error)) return