add unit test that triggers ifort18 assignment problem

Author: robertrueger

instantiations/derived_types/Animals.F90

@@ -0,0 +1,77 @@
+! Copyright (c) 2020  Software for Chemistry & Materials BV
+!
+! This file is part of of the Fortran Template Library.
+!
+! The Fortran Template Library is free software: you can redistribute it and/or
+! modify it under the terms of the GNU Lesser General Public License as
+! published by the Free Software Foundation, either version 3 of the License, or
+! (at your option) any later version.
+!
+! The Fortran Template Library is distributed in the hope that it will be
+! useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+! General Public License for more details.
+!
+! You should have received a copy of the GNU Lesser General Public License along
+! with the Fortran Template Library.  If not, see <http://www.gnu.org/licenses/>.
+
+
+module AnimalsModule
+
+   use ftlStringModule
+
+   implicit none
+   private
+
+   type, abstract, public :: AnimalType
+      type(ftlString) :: name
+   contains
+      procedure(MakeSoundInterface), public, deferred :: MakeSound
+   end type
+
+   interface
+      module subroutine MakeSoundInterface(self)
+         class(AnimalType), intent(inout) :: self
+      end subroutine
+   end interface
+
+   type, extends(AnimalType), public :: BirdType
+   contains
+      procedure, public :: NewBird
+      procedure, public :: MakeSound => MakeSoundBird
+   end type
+
+   type, extends(AnimalType), public :: CowType
+   contains
+      procedure, public :: NewCow
+      procedure, public :: MakeSound => MakeSoundCow
+   end type
+
+   type, public :: AnimalCageType
+      class(AnimalType), allocatable :: animal
+   end type
+
+contains
+
+   subroutine NewBird(self)
+      class(BirdType), intent(out) :: self
+      self%name = 'bird'
+   end subroutine NewBird
+
+   subroutine MakeSoundBird(self)
+      class(BirdType), intent(inout) :: self
+      print *, self%name%raw, ': Tweet'
+   end subroutine
+
+   subroutine NewCow(self)
+      class(CowType), intent(out) :: self
+      self%name = 'cow'
+   end subroutine NewCow
+
+   subroutine MakeSoundCow(self)
+      class(CowType), intent(inout) :: self
+      print *, self%name%raw, ': Moo'
+   end subroutine
+
+
+end module

makefile

@@ -152,7 +152,7 @@ $(BUILDDIR)/ftlAlgorithmsTests.o: tests/ftlAlgorithmsTests.F90 $(BUILDDIR)/ftlAr
 $(BUILDDIR)/ftlSharedPtrTests.o: tests/ftlSharedPtrTests.F90 $(BUILDDIR)/ftlSharedPtrInt.o | $(BUILDDIR)
 	$(COMPILER) $(FLAGS) $(INCLUDES) $(DEFINES) -c $< -o $@
 
-$(BUILDDIR)/ftlStringTests.o: tests/ftlStringTests.F90 $(BUILDDIR)/ftlString.o $(BUILDDIR)/ftlDynArrayString.o | $(BUILDDIR)
+$(BUILDDIR)/ftlStringTests.o: tests/ftlStringTests.F90 $(BUILDDIR)/ftlString.o $(BUILDDIR)/ftlDynArrayString.o $(BUILDDIR)/Animals.o | $(BUILDDIR)
 	$(COMPILER) $(FLAGS) $(INCLUDES) $(DEFINES) -c $< -o $@
 
 $(BUILDDIR)/ftlRegexTests.o: tests/ftlRegexTests.F90 $(BUILDDIR)/ftlRegex.o | $(BUILDDIR)
@@ -261,3 +261,6 @@ $(BUILDDIR)/Point2D.o: instantiations/derived_types/Point2D.F90 | $(BUILDDIR)
 
 $(BUILDDIR)/Leaky.o: instantiations/derived_types/Leaky.F90 | $(BUILDDIR)
 	$(COMPILER) $(FLAGS) $(INCLUDES) $(DEFINES) -c $< -o $@
+
+$(BUILDDIR)/Animals.o: instantiations/derived_types/Animals.F90 $(BUILDDIR)/ftlString.o | $(BUILDDIR)
+	$(COMPILER) $(FLAGS) $(INCLUDES) $(DEFINES) -c $< -o $@

src/ftlString.F90

@@ -162,6 +162,9 @@ module ftlStringModule
       ! assignment for ftlString that does the cleanup of the lhs explicitly, to at least fix these memory leaks when using
       ! ftlStrings ...
       generic, public :: assignment(=) => NewCopyOther
+      ! Note: ifort 18 does NOT like to have a defined assignment for ftlString in a couple of scenarios, see the
+      ! testContainingTypeAssignment regression test for ftlString. Relying on the intrinsic assignment makes that test work, but
+      ! will bring back the leaking ...
 #endif
 
       ! Overloaded operators:

tests/ftlStringTests.F90

@@ -106,6 +106,16 @@ subroutine ftlStringTests
       call testSplitWordsIntoDynArray
       call testDynArrayStringSpecialization
 
+      ! Really exotic tests for specific issues:
+
+#if !defined(__INTEL_COMPILER) || __INTEL_COMPILER >= 1900
+      ! This test fails with ifort 18. It's not a super major issue in practice, but it causes a segfault, so let's skip it here,
+      ! so that we can at least run all the tests ...
+      call testContainingTypeAssignment
+#else
+      write (*,'(A)') 'Skipping ftlStringtestContainingTypeAssignment for ftlString on ifort 18 ...'
+#endif
+
    end subroutine
 
 
@@ -1792,4 +1802,45 @@ subroutine testDynArrayStringSpecialization
    end subroutine
 
 
+   subroutine testContainingTypeAssignment
+
+      use AnimalsModule
+
+      integer :: i
+      type(AnimalCageType), allocatable :: cages(:)
+      type(AnimalCageType), allocatable :: newcages(:)
+
+      allocate(cages(3),newcages(3))
+      allocate(BirdType :: cages(1)%animal)
+      allocate(BirdType :: cages(2)%animal)
+      allocate(CowType  :: cages(3)%animal)
+      do i = 1, 3
+         select type (animal => cages(i)%animal)
+         type is (BirdType)
+            call animal%NewBird
+         type is (CowType)
+            call animal%NewCow
+         end select
+      end do
+
+      ASSERT(allocated(cages(1)%animal%name%raw))
+      ASSERT(cages(1)%animal%name == 'bird')
+      ASSERT(allocated(cages(2)%animal%name%raw))
+      ASSERT(cages(2)%animal%name == 'bird')
+      ASSERT(allocated(cages(3)%animal%name%raw))
+      ASSERT(cages(3)%animal%name == 'cow')
+
+      newcages = cages
+      deallocate(cages)
+
+      ASSERT(allocated(newcages(1)%animal%name%raw))
+      ASSERT(newcages(1)%animal%name == 'bird')
+      ASSERT(allocated(newcages(2)%animal%name%raw))
+      ASSERT(newcages(2)%animal%name == 'bird')
+      ASSERT(allocated(newcages(3)%animal%name%raw))
+      ASSERT(newcages(3)%animal%name == 'cow')
+
+   end subroutine
+
+
 end module