Merge pull request #892 from fortran-lang/fix-cpp

Fix bootstrapping on Windows

Author: minhqdao

src/fpm.f90

@@ -42,7 +42,7 @@ subroutine build_model(model, settings, package, error)
     type(package_config_t) :: dependency
     character(len=:), allocatable :: manifest, lib_dir, flags, cflags, cxxflags, ldflags
     logical :: has_cpp
-    logical :: duplicates_found = .false.
+    logical :: duplicates_found
     type(string_t) :: include_dir
 
     model%package_name = package%name
@@ -101,8 +101,7 @@ subroutine build_model(model, settings, package, error)
         associate(dep => model%deps%dep(i))
             manifest = join_path(dep%proj_dir, "fpm.toml")
 
-            call get_package_data(dependency, manifest, error, &
-                apply_defaults=.true.)
+            call get_package_data(dependency, manifest, error, apply_defaults=.true.)
             if (allocated(error)) exit
 
             model%packages(i)%name = dependency%name
@@ -118,7 +117,7 @@ subroutine build_model(model, settings, package, error)
                     if (dependency%preprocess(j)%name == "cpp") then
                         if (.not. has_cpp) has_cpp = .true.
                         if (allocated(dependency%preprocess(j)%macros)) then
-                        model%packages(i)%macros = dependency%preprocess(j)%macros
+                            model%packages(i)%macros = dependency%preprocess(j)%macros
                         end if
                     else
                         write(stderr, '(a)') 'Warning: Preprocessor ' // package%preprocess(i)%name // &
@@ -249,6 +248,7 @@ subroutine build_model(model, settings, package, error)
     if (allocated(error)) return
 
     ! Check for duplicate modules
+    duplicates_found = .false.
     call check_modules_for_duplicates(model, duplicates_found)
     if (duplicates_found) then
         call fpm_stop(1,'*build_model*:Error: One or more duplicate module names found.')

src/fpm/cmd/publish.f90

@@ -35,6 +35,7 @@ subroutine cmd_publish(settings)
     type(downloader_t) :: downloader
     integer :: i
 
+    ! Get package data to determine package version.
     call get_package_data(package, 'fpm.toml', error, apply_defaults=.true.)
     if (allocated(error)) call fpm_stop(1, '*cmd_build* Package error: '//error%message)
     version = package%version

src/fpm/manifest.f90

@@ -7,17 +7,17 @@
 !> Additionally, the required data types for users of this module are reexported
 !> to hide the actual implementation details.
 module fpm_manifest
-    use fpm_manifest_build, only: build_config_t
     use fpm_manifest_example, only : example_config_t
     use fpm_manifest_executable, only : executable_config_t
     use fpm_manifest_dependency, only : dependency_config_t
     use fpm_manifest_library, only : library_config_t
-    use fpm_mainfest_preprocess, only : preprocess_config_t
+    use fpm_manifest_preprocess, only : preprocess_config_t
     use fpm_manifest_package, only : package_config_t, new_package
     use fpm_error, only : error_t, fatal_error
     use fpm_toml, only : toml_table, read_package_file
     use fpm_manifest_test, only : test_config_t
     use fpm_filesystem, only: join_path, exists, dirname, is_dir
+    use fpm_environment, only: os_is_unix
     use fpm_strings, only: string_t
     implicit none
     private
@@ -109,7 +109,7 @@ subroutine get_package_data(package, file, error, apply_defaults)
         call read_package_file(table, file, error)
         if (allocated(error)) return
 
-        if (.not.allocated(table)) then
+        if (.not. allocated(table)) then
             call fatal_error(error, "Unclassified error while reading: '"//file//"'")
             return
         end if

src/fpm/manifest/build.f90

@@ -153,10 +153,7 @@ subroutine check(table, package_name, error)
         do ikey = 1, size(list)
             select case(list(ikey)%key)
 
-            case("auto-executables", "auto-examples", "auto-tests", "link", "external-modules")
-                continue
-
-            case ("module-naming")
+            case("auto-executables", "auto-examples", "auto-tests", "link", "external-modules", "module-naming")
                 continue
 
             case default

src/fpm/manifest/package.f90

@@ -43,13 +43,11 @@ module fpm_manifest_package
     use fpm_manifest_library, only : library_config_t, new_library
     use fpm_manifest_install, only: install_config_t, new_install_config
     use fpm_manifest_test, only : test_config_t, new_test
-    use fpm_mainfest_preprocess, only : preprocess_config_t, new_preprocessors
+    use fpm_manifest_preprocess, only : preprocess_config_t, new_preprocessors
     use fpm_filesystem, only : exists, getline, join_path
     use fpm_error, only : error_t, fatal_error, syntax_error, bad_name_error
-    use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, &
-        & len
+    use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, len
     use fpm_versioning, only : version_t, new_version
-    use fpm_filesystem, only: join_path
     implicit none
     private
 

src/fpm/manifest/preprocess.f90

@@ -10,7 +10,7 @@
 !> macros = []
 !> ```
 
-module fpm_mainfest_preprocess
+module fpm_manifest_preprocess
    use fpm_error, only : error_t, syntax_error
    use fpm_strings, only : string_t
    use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list
@@ -82,27 +82,17 @@ subroutine check(table, error)
 
       character(len=:), allocatable :: name
       type(toml_key), allocatable :: list(:)
-      logical :: suffixes_present, directories_present, macros_present
       integer :: ikey
 
-      suffixes_present = .false.
-      directories_present = .false.
-      macros_present = .false.
-
       call table%get_key(name)
       call table%get_keys(list)
 
       do ikey = 1, size(list)
          select case(list(ikey)%key)
-          case default
-            call syntax_error(error, "Key " // list(ikey)%key // "is not allowed in preprocessor"//name)
-            exit
-          case("suffixes")
-            suffixes_present = .true.
-          case("directories")
-            directories_present = .true.
-          case("macros")
-            macros_present = .true.
+         !> Valid keys.
+         case("suffixes", "directories", "macros")
+         case default
+            call syntax_error(error, "Key '"//list(ikey)%key//"' not allowed in preprocessor '"//name//"'."); exit
          end select
       end do
    end subroutine check
@@ -191,4 +181,4 @@ subroutine info(self, unit, verbosity)
 
    end subroutine info
 
-end module fpm_mainfest_preprocess
+end module fpm_manifest_preprocess

src/fpm_compiler.F90

@@ -773,8 +773,6 @@ function get_id(compiler) result(id)
     character(len=*), intent(in) :: compiler
     integer(kind=compiler_enum) :: id
 
-    integer :: stat
-
     if (check_compiler(compiler, "gfortran")) then
         id = id_gcc
         return

src/fpm_os.F90

@@ -3,9 +3,11 @@ module fpm_os
     use fpm_filesystem, only: exists, join_path, get_home
     use fpm_environment, only: os_is_unix
     use fpm_error, only: error_t, fatal_error
+
     implicit none
     private
-    public :: change_directory, get_current_directory, get_absolute_path, convert_to_absolute_path
+    public :: change_directory, get_current_directory, get_absolute_path, convert_to_absolute_path, &
+            & get_absolute_path_by_cd
 
     integer(c_int), parameter :: buffersize = 1000_c_int
 
@@ -47,8 +49,18 @@ function realpath(path, resolved_path) result(ptr) bind(C)
             type(c_ptr) :: ptr
         end function realpath
 
+        !> Determine the absolute, canonicalized path for a given path. Windows-only.
+        function fullpath(resolved_path, path, maxLength) result(ptr) bind(C, name="_fullpath")
+            import :: c_ptr, c_char, c_int
+            character(kind=c_char, len=1), intent(in) :: path(*)
+            character(kind=c_char, len=1), intent(out) :: resolved_path(*)
+            integer(c_int), value, intent(in) :: maxLength
+            type(c_ptr) :: ptr
+        end function fullpath
+
         !> Determine the absolute, canonicalized path for a given path.
-        !> Calls custom C routine and is able to distinguish between Unix and Windows.
+        !> Calls custom C routine because the `_WIN32` macro is correctly exported
+        !> in C using `gfortran`.
         function c_realpath(path, resolved_path, maxLength) result(ptr) &
             bind(C, name="c_realpath")
             import :: c_ptr, c_char, c_int
@@ -126,6 +138,10 @@ subroutine c_f_character(rhs, lhs)
     end subroutine c_f_character
 
     !> Determine the canonical, absolute path for the given path.
+    !>
+    !> Calls a C routine that uses the `_WIN32` macro to determine the correct function.
+    !>
+    !> Cannot be used in bootstrap mode.
     subroutine get_realpath(path, real_path, error)
         character(len=*), intent(in) :: path
         character(len=:), allocatable, intent(out) :: real_path
@@ -145,10 +161,7 @@ subroutine get_realpath(path, real_path, error)
 
         allocate (cpath(buffersize))
 
-! The _WIN32 macro is currently not exported using gfortran.
-#if defined(FPM_BOOTSTRAP) && !defined(_WIN32)
-        ptr = realpath(appended_path, cpath)
-#else
+#ifndef FPM_BOOTSTRAP
         ptr = c_realpath(appended_path, cpath, buffersize)
 #endif
 
@@ -158,7 +171,7 @@ subroutine get_realpath(path, real_path, error)
             call fatal_error(error, "Failed to retrieve absolute path for '"//path//"'.")
         end if
 
-    end subroutine get_realpath
+    end subroutine
 
     !> Determine the canonical, absolute path for the given path.
     !> Expands home folder (~) on both Unix and Windows.
@@ -169,49 +182,66 @@ subroutine get_absolute_path(path, absolute_path, error)
 
         character(len=:), allocatable :: home
 
+#ifdef FPM_BOOTSTRAP
+        call get_absolute_path_by_cd(path, absolute_path, error); return
+#endif
+
         if (len_trim(path) < 1) then
-            ! Empty path
-            call fatal_error(error, 'Path cannot be empty')
-            return
+            call fatal_error(error, 'Path cannot be empty'); return
         else if (path(1:1) == '~') then
-            ! Expand home
             call get_home(home, error)
             if (allocated(error)) return
 
             if (len_trim(path) == 1) then
-                absolute_path = home
-                return
+                absolute_path = home; return
             end if
 
             if (os_is_unix()) then
                 if (path(2:2) /= '/') then
-                    call fatal_error(error, "Wrong separator in path: '"//path//"'")
-                    return
+                    call fatal_error(error, "Wrong separator in path: '"//path//"'"); return
                 end if
             else
                 if (path(2:2) /= '\') then
-                    call fatal_error(error, "Wrong separator in path: '"//path//"'")
-                    return
+                    call fatal_error(error, "Wrong separator in path: '"//path//"'"); return
                 end if
             end if
 
             if (len_trim(path) == 2) then
-                absolute_path = home
-                return
+                absolute_path = home; return
             end if
 
             absolute_path = join_path(home, path(3:len_trim(path)))
 
             if (.not. exists(absolute_path)) then
-                call fatal_error(error, "Path not found: '"//absolute_path//"'")
-                deallocate (absolute_path)
-                return
+                call fatal_error(error, "Path not found: '"//absolute_path//"'"); return
             end if
         else
             ! Get canonicalized absolute path from either the absolute or the relative path.
             call get_realpath(path, absolute_path, error)
         end if
+    end subroutine
+
+    !> Alternative to `get_absolute_path` that uses `chdir`/`_chdir` to determine the absolute path.
+    !>
+    !> `get_absolute_path` is preferred but `get_absolute_path_by_cd` can be used in bootstrap mode.
+    subroutine get_absolute_path_by_cd(path, absolute_path, error)
+        character(len=*), intent(in) :: path
+        character(len=:), allocatable, intent(out) :: absolute_path
+        type(error_t), allocatable, intent(out) :: error
+
+        character(len=:), allocatable :: current_path
+
+        call get_current_directory(current_path, error)
+        if (allocated(error)) return
+
+        call change_directory(path, error)
+        if (allocated(error)) return
+
+        call get_current_directory(absolute_path, error)
+        if (allocated(error)) return
 
+        call change_directory(current_path, error)
+        if (allocated(error)) return
     end subroutine
 
     !> Converts a path to an absolute, canonical path.

test/fpm_test/test_manifest.f90

@@ -70,7 +70,8 @@ subroutine collect_manifest(tests)
             & new_unittest("preprocess-wrongkey", test_preprocess_wrongkey, should_fail=.true.), &
             & new_unittest("preprocessors-empty", test_preprocessors_empty, should_fail=.true.), &
             & new_unittest("macro-parsing", test_macro_parsing, should_fail=.false.), &
-            & new_unittest("macro-parsing-dependency", test_macro_parsing_dependency, should_fail=.false.)]
+            & new_unittest("macro-parsing-dependency", test_macro_parsing_dependency, should_fail=.false.) &
+            & ]
 
     end subroutine collect_manifest
 
@@ -669,26 +670,26 @@ subroutine test_build_valid(error)
             & 'name = "example"', &
             & '[build]', &
             & 'auto-executables = false', &
-            & 'auto-tests = false ', &
-            & 'module-naming = true '
+            & 'auto-tests = false', &
+            & 'module-naming = true'
         close(unit)
 
         call get_package_data(package, temp_file, error)
 
         if (allocated(error)) return
 
         if (package%build%auto_executables) then
-            call test_failed(error, "Wong value of 'auto-executables' read, expecting .false.")
+            call test_failed(error, "Wrong value of 'auto-executables' read, expecting .false.")
             return
         end if
 
         if (package%build%auto_tests) then
-            call test_failed(error, "Wong value of 'auto-tests' read, expecting .false.")
+            call test_failed(error, "Wrong value of 'auto-tests' read, expecting .false.")
             return
         end if
 
-        if (.not.package%build%module_naming) then
-            call test_failed(error, "Wong value of 'module-naming' read, expecting .true.")
+        if (.not. package%build%module_naming) then
+            call test_failed(error, "Wrong value of 'module-naming' read, expecting .true.")
             return
         end if
 
@@ -765,17 +766,17 @@ subroutine test_build_empty(error)
         if (allocated(error)) return
 
         if (.not.package%build%auto_executables) then
-            call test_failed(error, "Wong default value of 'auto-executables' read, expecting .true.")
+            call test_failed(error, "Wrong default value of 'auto-executables' read, expecting .true.")
             return
         end if
 
         if (.not.package%build%auto_tests) then
-            call test_failed(error, "Wong default value of 'auto-tests' read, expecting .true.")
+            call test_failed(error, "Wrong default value of 'auto-tests' read, expecting .true.")
             return
         end if
 
         if (package%build%module_naming) then
-            call test_failed(error, "Wong default value of 'module-naming' read, expecting .false.")
+            call test_failed(error, "Wrong default value of 'module-naming' read, expecting .false.")
             return
         end if
 
@@ -1318,7 +1319,7 @@ subroutine test_install_wrongkey(error)
     end subroutine test_install_wrongkey
 
     subroutine test_preprocess_empty(error)
-        use fpm_mainfest_preprocess
+        use fpm_manifest_preprocess
         use fpm_toml, only : new_table, toml_table
 
         !> Error handling
@@ -1336,7 +1337,7 @@ end subroutine test_preprocess_empty
 
     !> Pass a TOML table with not allowed keys
     subroutine test_preprocess_wrongkey(error)
-        use fpm_mainfest_preprocess
+        use fpm_manifest_preprocess
         use fpm_toml, only : new_table, add_table, toml_table
 
         !> Error handling
@@ -1357,7 +1358,7 @@ end subroutine test_preprocess_wrongkey
 
     !> Preprocess table cannot be empty.
     subroutine test_preprocessors_empty(error)
-        use fpm_mainfest_preprocess
+        use fpm_manifest_preprocess
         use fpm_toml, only : new_table, toml_table
 
         !> Error handling