From c63e6f13562322d4a47fe52da88ef094334ddd39 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Fri, 1 Mar 2019 09:39:51 -0500 Subject: [PATCH] Eliminating some compiler kludges. A use case in fArgParse revealed an ifort-19 compiler error in using gFTL. Further investigation suggested that some gFTL workarounds are no longer necessary (ifort 18.0.3 and above). The workaround for the ifort-19 issue is outside of gFTL. (String wrapper needs an explicit type constructor for ifort, and gfortran requires the wrapper in unlimited polymorphic contexts that include deferred length strings.) --- cmake_utils/Intel.cmake | 1 + include/templates/altSet_decl.inc | 4 -- include/templates/altSet_impl.inc | 3 +- include/templates/vector_decl.inc | 2 - tests/Map/CMakeLists.txt | 9 +++- tests/Map/Test_map_double_assign.pf | 74 +++++++++++++++++++++++++++++ tests/Map/altMapTestSuites.inc | 1 + 7 files changed, 85 insertions(+), 9 deletions(-) create mode 100644 tests/Map/Test_map_double_assign.pf diff --git a/cmake_utils/Intel.cmake b/cmake_utils/Intel.cmake index d8ba5ef..872b4f9 100644 --- a/cmake_utils/Intel.cmake +++ b/cmake_utils/Intel.cmake @@ -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) diff --git a/include/templates/altSet_decl.inc b/include/templates/altSet_decl.inc index cc8c5fd..d1200a4 100644 --- a/include/templates/altSet_decl.inc +++ b/include/templates/altSet_decl.inc @@ -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 diff --git a/include/templates/altSet_impl.inc b/include/templates/altSet_impl.inc index a4bd3c0..8f86e69 100644 --- a/include/templates/altSet_impl.inc +++ b/include/templates/altSet_impl.inc @@ -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) diff --git a/include/templates/vector_decl.inc b/include/templates/vector_decl.inc index 9e5cc64..511f923 100644 --- a/include/templates/vector_decl.inc +++ b/include/templates/vector_decl.inc @@ -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) diff --git a/tests/Map/CMakeLists.txt b/tests/Map/CMakeLists.txt index fcafa70..16b4e0b 100644 --- a/tests/Map/CMakeLists.txt +++ b/tests/Map/CMakeLists.txt @@ -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 diff --git a/tests/Map/Test_map_double_assign.pf b/tests/Map/Test_map_double_assign.pf new file mode 100644 index 0000000..78bf983 --- /dev/null +++ b/tests/Map/Test_map_double_assign.pf @@ -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 diff --git a/tests/Map/altMapTestSuites.inc b/tests/Map/altMapTestSuites.inc index becf2cd..1fee5f9 100644 --- a/tests/Map/altMapTestSuites.inc +++ b/tests/Map/altMapTestSuites.inc @@ -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)