Merge pull request #341 from Goddard-Fortran-Ecosystem/hotfix/128bit-…

…real-fixes-and-pgi-support

Fixes to enable PGI compiler support

CMakeLists.txt

@@ -25,7 +25,7 @@
 cmake_minimum_required(VERSION 3.12)
 
 project (PFUNIT
-  VERSION 4.2.2
+  VERSION 4.2.3
   LANGUAGES Fortran C)
 
 # Determine if pFUnit is built as a subproject (using

ChangeLog.md

@@ -5,6 +5,15 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+## [4.2.2] - 2022-03-09
+
+
+
+### Fixed
+
+ - Incorrect treatment of 128 bit real support for compilers that do not support REAL128.
+ - Incorrect compilel flags for PGI
+
 ### Changed
 
  - When any tests fail, the driver now invokes Fortran `STOP` instead of

cmake/NVHPC.cmake

@@ -0,0 +1,10 @@
+# Compiler specific flags for PGI Fortran compiler
+# (or is this now NVIDIA?)
+
+set(traceback "-traceback")
+set(check_all "-Mbounds -Mchkstk")
+
+set(CMAKE_Fortran_FLAGS_DEBUG  "-O0")
+set(CMAKE_Fortran_FLAGS_RELEASE "-O3")
+set(CMAKE_Fortran_FLAGS "-g ${traceback} ${check_all} -Mallocatable=03")
+

cmake/PGI.cmake

@@ -2,7 +2,7 @@
 # (or is this now NVIDIA?)
 
 set(traceback "-traceback")
-set(check_all "-Mbounds -Mchkfpstk -Mchkstk")
+set(check_all "-Mbounds -Mchkstk")
 
 set(CMAKE_Fortran_FLAGS_DEBUG  "-O0")
 set(CMAKE_Fortran_FLAGS_RELEASE "-O3")

src/funit/fhamcrest/BaseDescription.F90

@@ -115,7 +115,7 @@ recursive subroutine append_value_scalar(this, value)
         call this%append(description_of(value))
         call this%append('_real64>')
 #endif
-#if (defined(_ISO_REAL128) && (_ISO_REAL64 != _REAL_DEFAULT_KIND) && (_ISO_REAL128 != _DOUBLE_DEFAULT_KIND))
+#if (defined(_ISO_REAL128) && (_ISO_REAL128 != _REAL_DEFAULT_KIND) && (_ISO_REAL128 != _DOUBLE_DEFAULT_KIND))
      type is (real(kind=REAL128))
         call this%append('<')
         call this%append(description_of(value))
@@ -305,6 +305,7 @@ function description_of_real64(value) result(string)
     end function description_of_real64
 
 
+#if (defined(_ISO_REAL128) && (_ISO_REAL128 != _REAL_DEFAULT_KIND) && (_ISO_REAL128 != _DOUBLE_DEFAULT_KIND))
     function description_of_real128(value) result(string)
       use pf_Matchable
       character(:), allocatable :: string
@@ -314,6 +315,7 @@ function description_of_real128(value) result(string)
       write(buffer,'(g0)') value
       string = trim(buffer)
     end function description_of_real128
+#endif
 
     function description_of_complex32(value) result(string)
       use pf_Matchable
@@ -332,13 +334,15 @@ function description_of_complex64(value) result(string)
     end function description_of_complex64
 
 
+#if (defined(_ISO_REAL128) && (_ISO_REAL128 != _REAL_DEFAULT_KIND) && (_ISO_REAL128 != _DOUBLE_DEFAULT_KIND))
     function description_of_complex128(value) result(string)
       use pf_Matchable
       character(:), allocatable :: string
       complex(kind=REAL128), intent(in) :: value
 
       string = "(" // description_of(real(value)) // "," // description_of(aimag(value)) // ")"
     end function description_of_complex128
+#endif
 
 
 end module pf_BaseDescription

src/funit/fhamcrest/IsEqual.F90

@@ -220,6 +220,8 @@ logical function matches_intrinsic(this, actual_value)
     class(IsEqual), intent(in) :: this
     class(*), target, intent(in) :: actual_value
 
+     integer, parameter :: DP = kind(1.d0)
+
     select type (e => this%expected_value)
     type is (logical)
        select type(a => actual_value)
@@ -242,48 +244,88 @@ logical function matches_intrinsic(this, actual_value)
        class default
           matches_intrinsic = .false.
        end select
+    type is (real)
+       select type(a => actual_value)
+       type is (real)
+          matches_intrinsic = (e == a)
+       class default
+          matches_intrinsic = .false.
+       end select
+    type is (real(kind=DP))
+       select type(a => actual_value)
+       type is (real(kind=DP))
+          matches_intrinsic = (e == a)
+       class default
+          matches_intrinsic = .false.
+       end select
+#if (defined(_ISO_REAL32) && (_ISO_REAL32 != _REAL_DEFAULT_KIND) && (_ISO_REAL32 != _DOUBLE_DEFAULT_KIND))
     type is (real(kind=REAL32))
        select type(a => actual_value)
        type is (real(kind=REAL32))
           matches_intrinsic = (e == a)
        class default
           matches_intrinsic = .false.
        end select
+#endif
+#if (defined(_ISO_REAL64) && (_ISO_REAL64 != _REAL_DEFAULT_KIND) && (_ISO_REAL64 != _DOUBLE_DEFAULT_KIND))
     type is (real(kind=REAL64))
        select type(a => actual_value)
        type is (real(kind=REAL64))
           matches_intrinsic = (e == a)
        class default
           matches_intrinsic = .false.
        end select
+#endif
+#if (defined(_ISO_REAL128) && (_ISO_REAL128 != _REAL_DEFAULT_KIND) && (_ISO_REAL128 != _DOUBLE_DEFAULT_KIND))
     type is (real(kind=REAL128))
        select type(a => actual_value)
        type is (real(kind=REAL128))
           matches_intrinsic = (e == a)
        class default
           matches_intrinsic = .false.
        end select
+#endif
+    type is (complex)
+       select type(a => actual_value)
+       type is (complex)
+          matches_intrinsic = (e == a)
+       class default
+          matches_intrinsic = .false.
+       end select
+     type is (complex(kind=DP))
+       select type(a => actual_value)
+       type is (complex(kind=DP))
+          matches_intrinsic = (e == a)
+       class default
+          matches_intrinsic = .false.
+       end select
+#if (defined(_ISO_REAL32) && (_ISO_REAL32 != _REAL_DEFAULT_KIND) && (_ISO_REAL32 != _DOUBLE_DEFAULT_KIND))
     type is (complex(kind=REAL32))
        select type(a => actual_value)
        type is (complex(kind=REAL32))
           matches_intrinsic = (e == a)
        class default
           matches_intrinsic = .false.
        end select
+#endif
+#if (defined(_ISO_REAL64) && (_ISO_REAL64 != _REAL_DEFAULT_KIND) && (_ISO_REAL64 != _DOUBLE_DEFAULT_KIND))
     type is (complex(kind=REAL64))
        select type(a => actual_value)
        type is (complex(kind=REAL64))
           matches_intrinsic = (e == a)
        class default
           matches_intrinsic = .false.
        end select
+#endif
+#if (defined(_ISO_REAL128) && (_ISO_REAL128 != _REAL_DEFAULT_KIND) && (_ISO_REAL128 != _DOUBLE_DEFAULT_KIND))
     type is (complex(kind=REAL128))
        select type(a => actual_value)
        type is (complex(kind=REAL128))
           matches_intrinsic = (e == a)
        class default
           matches_intrinsic = .false.
        end select
+#endif
     type is (character(*))
        select type(a => actual_value)
        type is (character(*))