Merge pull request #51 from sourceryinstitute/fix-ibm-build

Fix IBM XL Fortran build

Author: rouson

README.md

@@ -99,12 +99,12 @@ fpm test --compiler nagfor --flag -fpp
 
 ### IBM (`xlf2003_r`)
 ```
-fpm test --compiler xlf2003_r
+fpm test --compiler xlf2003_r --flag -DXLF
 ```
 
 ### Intel (`ifort`)
 ```
-fpm test --compiler ifort --flag -coarray=shared
+fpm test --compiler ifort --flag
 ```
 
 ### GCC (`gfortran`)

example/test-support/specification_expression_finalization.f90 renamed to example/test-support/specification_expression_finalization.F90

@@ -1,7 +1,15 @@
 module finalizable_m
-  !! This module supports the specification_expression_finalization main program 
-  !! (at the bottom of this file), which in turn supports the check_specification_expression 
-  !! unit-test function in ../test/compiler_test.f90.
+  !! This module supports the main program at the bottom of this file, which
+  !! tests compiler conformance with clause 7.5.6.3, paragraph 6 in the Fortran
+  !! Interpretation Document (https://j3-fortran.org/doc/year/18/18-007r1.pdf):
+  !! "If a specification expression in a scoping unit references
+  !! a function, the result is finalized before execution of the executable
+  !! constructs in the scoping unit."  (The same statement appears in clause
+  !! 4.5.5.2, paragraph 5 of the Fortran 2003 standard.) In such a scenario,
+  !! the final subroutine must be pure.  The only way to observe output from
+  !! a pure final subroutine is for the subroutine to execute an error stop
+  !! statement.  A correct execution of this test will error-terminate and ouput 
+  !! the text "finalize: intentional error termination to verify finalization".
   implicit none
 
   private
@@ -29,14 +37,22 @@ pure function construct(component) result(finalizable)
   pure function component(self) result(self_component)
     type(finalizable_t), intent(in) :: self
     integer self_component
+#ifdef XLF
+    if (.not. associated(self%component_)) error stop 1 ! work around xlf2003_r bug reported via OLCF (Ticket OLCFHELP-9069)
+#else
     if (.not. associated(self%component_)) error stop "component: unassociated component"
+#endif
     self_component = self%component_
   end function
 
   pure subroutine finalize(self)
     type(finalizable_t), intent(inout) :: self
     if (associated(self%component_)) deallocate(self%component_)
+#ifdef XLF
+    error stop 2 ! work around xlf2003_r bug reported via OLCF (Ticket OLCFHELP-9069)
+#else
     error stop "finalize: intentional error termination to verify finalization"
+#endif
   end subroutine
 
 end module
@@ -52,6 +68,8 @@ program specification_expression_finalization
 
   subroutine finalize_specification_expression_result
     real tmp(component(finalizable_t(component=0))) !! Finalizes the finalizable_t function result
+    real eliminate_unused_variable_warning 
+    tmp = eliminate_unused_variable_warning 
   end subroutine
 
 end program

fpm.toml

@@ -1,9 +1,6 @@
-name = "reference_counter"
-version = "1.0.0"
+name = "smart_pointers"
+version = "2.1.0"
 license = "BSD"
 author = ["Damian Rouson, Karla Morris, and Jim Xia"]
 maintainer = "[email protected]"
 copyright = "2020-2022 Sourcery Institute"
-
-[dependencies]
-assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.3.0"}

src/smart_pointer/assert_m.F90

@@ -0,0 +1,26 @@
+module assert_m
+  !! Enforce logical assertions that can be toggled on/off at compile-time
+  !! To turn off assertions, building with the flag -DUSE_ASSERTIONS=.false.
+  implicit none
+
+  private
+  public :: assert
+
+#ifndef USE_ASSERTIONS
+# define USE_ASSERTIONS .true.
+#endif
+  logical, parameter :: enforce_assertions = USE_ASSERTIONS
+
+  interface 
+
+     pure module subroutine assert(assertion, description)
+       !! Error terminate on .false. assertion with the stop code given by description
+       !! With IBM XL Fortran, the stop code is an integer due to for character stop codes being unsupported.
+       implicit none
+       logical, intent(in) :: assertion
+       character(len=*), intent(in) :: description
+     end subroutine
+
+  end interface
+
+end module assert_m

src/smart_pointer/assert_s.F90

@@ -0,0 +1,18 @@
+submodule(assert_m) assert_s
+  implicit none
+
+contains
+
+  module procedure assert
+
+    if (enforce_assertions) then
+#ifdef XLF
+      if (.not. assertion) error stop 999
+#else
+      if (.not. assertion) error stop description
+#endif
+    end if
+
+  end procedure
+
+end submodule assert_s

src/smart_pointer/sp_smart_pointer_s.f90 renamed to src/smart_pointer/sp_smart_pointer_s.F90

@@ -1,4 +1,7 @@
 submodule(sp_smart_pointer_m) sp_smart_pointer_s
+#ifdef XLF
+  use sp_reference_counter_m, only : sp_reference_counter_t 
+#endif
   implicit none
 
 contains

test/compiler_test_m.f90

@@ -232,7 +232,9 @@ function fpm_compiler_arguments() result(args)
         else if (scan(compiler_identity, "NAG")==1) then
           args = "--compiler nagfor --flag -fpp"
         else if (scan(compiler_identity, "Intel")==1) then
-          args = "--compiler ifort --flag -coarray=shared"
+          args = "--compiler ifort --flag"
+        else if (scan(compiler_identity, "IBM")==1) then
+          args = "--compiler xlf2003_r --flag -DXLF"
         else
           error stop "----> Unrecognized compiler_version() in function fpm_compiler_arguments. <----"
         end if

test/test_m.f90 renamed to test/test_m.F90

@@ -38,6 +38,9 @@ module subroutine report(test)
 end module test_m
 
 submodule(test_m) test_s
+#ifdef XLF
+  use test_result_m, only : test_result_t
+#endif
   implicit none
 
 contains