Skip to content

Commit

Permalink
Merge pull request #62 from Goddard-Fortran-Ecosystem/develop
Browse files Browse the repository at this point in the history
Develop
  • Loading branch information
tclune authored Mar 1, 2019
2 parents 5c02056 + 586c2e3 commit 9b8ea8f
Show file tree
Hide file tree
Showing 7 changed files with 85 additions and 9 deletions.
1 change: 1 addition & 0 deletions cmake_utils/Intel.cmake
Original file line number Diff line number Diff line change
Expand Up @@ -19,3 +19,4 @@ set(CMAKE_Fortran_FLAGS_RELEASE "-O3")
set(CMAKE_Fortran_FLAGS "-g ${cpp} ${traceback} ${check_all} ${disable_warning_for_long_names} -save-temps")

add_definitions(-D_INTEL)
#add_definitions(-D__ifort_18)
4 changes: 0 additions & 4 deletions include/templates/altSet_decl.inc
Original file line number Diff line number Diff line change
Expand Up @@ -36,13 +36,9 @@
procedure :: remove => __PROC(remove)
procedure :: begin => __PROC(begin)
procedure :: end => __PROC(end)
!!$#ifdef _DUMP_TREE
procedure :: dump => __PROC(dump)
!!$#endif
procedure :: deepCopy => __PROC(deepCopy)
#ifndef __ifort_18
generic :: assignment(=) => deepCopy
#endif
procedure :: equalSets
generic :: operator(==) => equalSets
procedure :: notEqualSets
Expand Down
3 changes: 1 addition & 2 deletions include/templates/altSet_impl.inc
Original file line number Diff line number Diff line change
Expand Up @@ -944,14 +944,13 @@
type (__iterator) :: iter
__type_declare_result, pointer :: ptr

#if !defined(__INTEL_COMPILER) | !(defined(_string) & !defined(_string_deferred))
iter = other%begin()
do while (iter /= other%end())
ptr => iter%value()
call this%insert(ptr)
call iter%next()
end do
#endif

this%tsize = other%tsize

end subroutine __PROC(deepCopy)
Expand Down
2 changes: 0 additions & 2 deletions include/templates/vector_decl.inc
Original file line number Diff line number Diff line change
Expand Up @@ -66,9 +66,7 @@

#ifndef __type_wrapped
procedure :: copyFromArray => __PROC(copyfromarray)
#ifndef __ifort_18
generic :: assignment(=) => copyFromArray
#endif
#endif
procedure :: push_back => __PROC(push_back)
procedure :: pop_back => __PROC(pop_back)
Expand Down
9 changes: 8 additions & 1 deletion tests/Map/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,14 @@ add_custom_command (
WORKING_DIRECTORY ${bin}
DEPENDS ${src}/Test_map_Allocatable.pf
)
list(APPEND SRCS Test_map_Allocatable.F90)

add_custom_command (
OUTPUT Test_map_double_assign.F90
COMMAND ${PFUNIT}/bin/pFUnitParser.py ${src}/Test_map_double_assign.pf Test_map_double_assign.F90
WORKING_DIRECTORY ${bin}
DEPENDS ${src}/Test_map_double_assign.pf
)
list(APPEND SRCS Test_map_Allocatable.F90 Test_map_double_assign.F90)

add_custom_command (
OUTPUT AuxTest.F90
Expand Down
74 changes: 74 additions & 0 deletions tests/Map/Test_map_double_assign.pf
Original file line number Diff line number Diff line change
@@ -0,0 +1,74 @@
! Test for use fArgParse use case that fails with ifort-19. Issue is
! apparently related to copying of StringUnlimited maps at multiple
! levels. In the use case a function is used to return a map, and the
! retun value is itself a function return at the level above.

module String_mod
implicit none
private

public :: String
type :: String
character(:), allocatable :: string
end type String

end module String_mod

module UnlimitedMap_mod
#include "types/key_deferredLengthString.inc"
#include "types/value_unlimitedPoly.inc"
#define _alt
#include "templates/map.inc"
end module UnlimitedMap_mod


module Test_map_double_assigne_mod
use String_mod
use pFUnit_mod
use UnlimitedMap_mod

@suite(name='Test_map_double_assign_suite')

type :: ArgParser
class(*), allocatable :: default
end type ArgParser


contains

subroutine get_defaults(this, option_values)
type (Map), intent(out) :: option_values
class (ArgParser), target, intent(inout) :: this

class(*), pointer :: q

this%default = 'TestRunner'
q => this%default

select type (q)
type is (character(*))
print*,__FILE__,__LINE__
call option_values%insert('runner', String(q))
end select

end subroutine get_defaults

@test
subroutine test_unlimited
type (Map) :: m
type (ArgParser) :: p

class(*), pointer :: opt

print*,__FILE__,__LINE__
call get_defaults(p, m)
opt => m%at('runner')
select type (opt)
class is (String)
@assertEqual('TestRunner', opt%string)
class default
@assertFalse(.true.,message='should not get here')
end select

end subroutine test_unlimited
end module Test_map_double_assigne_mod
1 change: 1 addition & 0 deletions tests/Map/altMapTestSuites.inc
Original file line number Diff line number Diff line change
Expand Up @@ -32,3 +32,4 @@ ADD_TEST_SUITE(Test_integer1dinteger1daltMap_mod_suite)

! Test for robust pointers to allocatable components
ADD_TEST_SUITE(Test_map_Allocatable_suite)
ADD_TEST_SUITE(Test_map_double_assign_suite)

0 comments on commit 9b8ea8f

Please sign in to comment.