Skip to content

Fix IBM XL Fortran build #51

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Oct 2, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -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`)
Expand Down
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
7 changes: 2 additions & 5 deletions fpm.toml
Original file line number Diff line number Diff line change
@@ -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 = "damian@archaeologic.codes"
copyright = "2020-2022 Sourcery Institute"

[dependencies]
assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.3.0"}
26 changes: 26 additions & 0 deletions src/smart_pointer/assert_m.F90
Original file line number Diff line number Diff line change
@@ -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
18 changes: 18 additions & 0 deletions src/smart_pointer/assert_s.F90
Original file line number Diff line number Diff line change
@@ -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
Original file line number Diff line number Diff line change
@@ -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
Expand Down
4 changes: 3 additions & 1 deletion test/compiler_test_m.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 3 additions & 0 deletions test/test_m.f90 → test/test_m.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down