Merge branch 'develop' into master

bin/funit/pFUnitParser.py

@@ -19,7 +19,7 @@ def __str__(self):
                    'relativelyequal': 2, 'isinfinite': 1, 'isfinite': 1,
                    'isnan': 1, 'ismemberof': 2, 'contains': 2, 'any': 1,
                    'all': 1, 'notall': 1, 'none': 1, 'ispermutationof': 2,
-                   'exceptionraised': 0, 'sameshape': 2, '_that':2}
+                   'exceptionraised': 0, 'sameshape': 2, 'that': 2, '_that': 2}
 
 def cppSetLineAndFile(line, file):
     return "#line " + str(line) + ' "' + file + '"\n'

cmake/GNU.cmake

@@ -7,8 +7,8 @@ set(cpp "-cpp")
 
 set(CMAKE_Fortran_FLAGS_DEBUG  "-O0")
 set(CMAKE_Fortran_FLAGS_RELEASE "-O3")
-set(CMAKE_Fortran_FLAGS "-g ${cpp} ${traceback} ${check_all} -ffree-line-length-512")
+#set(CMAKE_Fortran_FLAGS "-g ${cpp} -O0 ${traceback} ${check_all} -ffree-line-length-512")
+set(CMAKE_Fortran_FLAGS "-g ${cpp} -O0 ${traceback}  -ffree-line-length-512")
 
 
 add_definitions(-D_GNU)
-#add_definitions(-D__GFORTRAN__)

cmake/PFUNITConfig.cmake.in

@@ -97,7 +97,7 @@ function (add_pfunit_test test_package_name test_sources extra_sources extra_sou
         list (GET test_sources_f90 ${i} f90_file)
         add_custom_command(
             OUTPUT ${f90_file}
-            COMMAND ${PFUNIT_PARSER} ${pf_file} ${CMAKE_CURRENT_BINARY_DIR}/${f90_file}
+            COMMAND ${PFUNIT_PARSER} ${pf_file} ${f90_file}
             MAIN_DEPENDENCY ${pf_file}
 	    WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
             #COMMENT "Generating '${f90_file}' from '${pf_file}'"

src/funit/core/RobustRunner.F90

@@ -171,7 +171,7 @@ subroutine runWithResult(this, aTest, context, result)
       do i = 1, testCases%size()
          if (needs_launch) then
             !TODO:  What is the correct mode here?
-            mode%mode_t = O'0777'
+            mode%mode_t = INT( O'0777' )
             rc = mkfifo(C_REMOTE_PROCESS_PIPE, mode)
             if (rc /= 0) ERROR STOP 'failed to make named pipe'
 

src/funit/fhamcrest/AbstractArrayWrapper.F90

@@ -0,0 +1,43 @@
+! Array wrappers allow the framework to treat arrays as single
+! objects.  This separates concerns of overloading by type (via
+! unlimited polymorphic) vs overloading by rank.
+
+module pf_AbstractArrayWrapper
+  implicit none
+  private
+
+  public :: AbstractArrayWrapper
+
+  type, abstract :: AbstractArrayWrapper
+   contains
+     procedure(get_ith), deferred :: get_ith
+     procedure(get), deferred :: get
+     procedure(to_list), deferred :: to_list
+  end type AbstractArrayWrapper
+
+  abstract interface
+
+     function get_ith(this, i) result(item)
+       import AbstractArrayWrapper
+       class(*), allocatable :: item
+       class(AbstractArrayWrapper), target, intent(in) :: this
+       integer, intent(in) :: i
+     end function get_ith
+
+     function get(this) result(list)
+       import AbstractArrayWrapper
+       class(*), allocatable :: list(:)
+       class(AbstractArrayWrapper), intent(in) :: this
+     end function get
+
+     subroutine to_list(this, list)
+       import AbstractArrayWrapper
+       class(AbstractArrayWrapper), intent(in) :: this
+       class(*), allocatable, intent(out) :: list(:)
+     end subroutine to_list
+
+  end interface
+
+end module pf_AbstractArrayWrapper
+
+

src/funit/fhamcrest/ArrayWrapper.tmpl

@@ -0,0 +1,96 @@
+! -*-f90-*-
+! This module allows pFUnit to treat arrays as single objects which
+! greatly simplifies the overloading of hamcrest matcher interfaces.
+! Once SELECT RANK (Fortran 2015) is widely available, this should
+! be re-engineered.
+
+module pf_ArrayWrapper_{rank}d
+  use pf_AbstractArrayWrapper
+  {use_rank_minus_1}
+  implicit none
+  private
+
+  public :: ArrayWrapper
+  public :: ArrayWrapper_{rank}d
+
+  interface ArrayWrapper
+     module procedure wrap
+  end interface ArrayWrapper
+
+  type, extends(AbstractArrayWrapper) :: ArrayWrapper_{rank}d
+     class(*), allocatable :: items {dims}
+   contains
+     procedure :: get
+     procedure :: get_ith
+     procedure :: to_list
+  end type ArrayWrapper_{rank}d
+
+contains
+
+  function wrap(items) result(a)
+    type (ArrayWrapper_{rank}d) :: a
+    class(*), intent(in) :: items {dims}
+    allocate(a%items, source=items)
+  end function wrap
+
+  function get(this) result(list)
+    class(*), allocatable :: list(:)
+    class (ArrayWrapper_{rank}d), intent(in) :: this
+
+#if {rank} > 1
+    integer :: i, n
+    type (ArrayWrapper_{rank_minus_1}d), allocatable :: items(:)
+#endif
+
+#if {rank}==1
+    ! GFortran 9.2 has some issues with polymorphic intrinsic
+    ! assignment in this context.
+    allocate(list, source=this%items)
+#else
+    n = size(this%items)
+    allocate(items(n))
+    do i = 1, n
+       items(i) = {get_ith}
+    end do
+    ! GFortran 9.2 has some issues with polymorphic intrinsic
+    ! assignment in this context.
+    allocate(list, source=items)
+#endif
+
+  end function get
+
+  function get_ith(this, i) result(item)
+    class(*), allocatable :: item
+    class(ArrayWrapper_{rank}d), target, intent(in) :: this
+    integer, intent(in) :: i
+
+    item = {get_ith}
+
+  end function get_ith
+
+  subroutine to_list(this, list)
+    class (ArrayWrapper_{rank}d), intent(in) :: this
+    class(*), allocatable, intent(out) :: list(:)
+
+#if {rank} > 1
+    integer :: i, n
+    type (ArrayWrapper_{rank_minus_1}d), allocatable :: items(:)
+#endif
+#if {rank}==1
+    ! GFortran 9.2 has some issues with polymorphic intrinsic
+    ! assignment in this context.
+    allocate(list, source=this%items)
+#else
+    n = size(this%items)
+    allocate(items(n))
+    do i = 1, n
+       items(i) = {get_ith}
+    end do
+    ! GFortran 9.2 has some issues with polymorphic intrinsic
+    ! assignment in this context.
+    allocate(list, source=items)
+#endif
+
+  end subroutine to_list
+
+end module pf_ArrayWrapper_{rank}d

src/funit/fhamcrest/BaseDescription.F90

@@ -2,6 +2,8 @@ module pf_BaseDescription
   use pf_MatcherDescription
   use pf_SelfDescribing
   use pf_SelfDescribingVector
+  use pf_AbstractArrayWrapper
+  use pf_ArrayWrapper
   use, intrinsic :: iso_fortran_env
    implicit none
    private
@@ -15,13 +17,13 @@ module pf_BaseDescription
       procedure :: append_text
       procedure :: append_description_of
       procedure :: append_value_scalar
-      procedure :: append_value_list
+      procedure :: append_value_array_1d
       procedure :: append_string
       procedure(append_character), deferred :: append_character
       generic :: append => append_string
       generic :: append => append_character
-      procedure :: append_list_array
       procedure :: append_list_vector
+      procedure :: append_list_array
    end type BaseDescription
 
    abstract interface 
@@ -67,7 +69,6 @@ end subroutine append_description_of
 
    recursive subroutine append_value_scalar(this, value)
      use pf_Matchable
-     use pf_Array
      class (BaseDescription), intent(inout) :: this
      class(*), intent(in) :: value
 
@@ -148,22 +149,17 @@ recursive subroutine append_value_scalar(this, value)
         call this%append('<')
         call value%type_unsafe_describe_to(this)
         call this%append('>')
-     class is (internal_array)
-        select type (value)
-        class is (internal_array_1d)
-           call this%append_value_list("[",", ","]",value%items)
-        class default
-           ERROR STOP __FILE__ // ' :: unsupported rank'
-        end select
+     class is (AbstractArrayWrapper)
+        call this%append_value("[",", ","]",value%get())
      class default
         ERROR STOP __FILE__ // ' :: unsupported type'
      end select
 
     end subroutine append_value_scalar
 
-    subroutine append_value_list(this, start, separator, end, values)
+    subroutine append_value_array_1d(this, start, separator, end, values)
      use pf_Matchable
-     use pf_Array
+     use pf_AbstractArrayWrapper
      class (BaseDescription), intent(inout) :: this
      character(*), intent(in) :: start
      character(*), intent(in) :: separator
@@ -175,9 +171,9 @@ subroutine append_value_list(this, start, separator, end, values)
 
      separate = .false.
 
-     select type (values)
+     select type (q => values)
      class is (SelfDescribing)
-        call this%append_list(start, separator, end, values)
+        call this%append_list(start, separator, end, q)
      class default
         call this%append(start)
         do i = 1, size(values)
@@ -188,8 +184,7 @@ subroutine append_value_list(this, start, separator, end, values)
         call this%append(end)
      end select
 
-   end subroutine append_value_list
-
+   end subroutine append_value_array_1d
 
     ! JUnit does this, but it seems overkill. Currently am not planning
     ! to intercept special characters.   Will be overridden in StringDescription.
@@ -227,6 +222,7 @@ subroutine append_list_array(this, start, separator, end, values)
 
     end subroutine append_list_array
 
+
     subroutine append_list_vector(this, start, separator, end, values)
       class(BaseDescription), intent(inout) :: this
       character(*), intent(in) :: start
@@ -348,5 +344,5 @@ function description_of_complex128(value) result(string)
       string = trim(buffer)
     end function description_of_complex128
 
-    
+
 end module pf_BaseDescription