better CI and Fortran standard adherence

Author: scivision

.travis.yml

@@ -4,6 +4,7 @@ fast_finish: true
 python: 
   - 2.7
   - 3.6
+  - "3.7-dev"
 
 os:
   - linux
@@ -25,11 +26,11 @@ addons:
 
 before_install:
   - if [[ $TRAVIS_OS_NAME == osx ]]; then
-      brew update;
-      brew install gcc || true;
-      brew link --overwrite gcc;
+      brew update > /dev/null;
+      brew install gcc || true > /dev/null;
+      brew link --overwrite gcc > /dev/null;
       export FC=gfortran;
-      brew install opencoarrays;
+      brew install opencoarrays > /dev/null;
     fi
 
 install:
@@ -38,6 +39,7 @@ install:
   - cd bin
   - cmake ..
   - make
+  - make test
   - cd ..
 
 script: 

CMakeLists.txt

@@ -2,7 +2,12 @@ cmake_minimum_required(VERSION 3.7)
 project(lineclip Fortran)
 enable_testing()
 
-add_compile_options(-O3 -g)
+
+if(CMAKE_BUILD_TYPE STREQUAL Debug)
+  add_compile_options(-g -O0)
+else()
+  add_compile_options(-O3)
+endif()
 
 if(${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU)
   if(${CMAKE_Fortran_COMPILER_VERSION} VERSION_GREATER_EQUAL 8.1)
@@ -15,14 +20,17 @@ if(${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU)
   if(NOT CYGWIN AND NOT WIN32)
     list(APPEND FFLAGS -fstack-protector-all)
   endif()
+elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL PGI)
+  list(APPEND FFLAGS -Mallocatable=03)
 elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL Flang)
+  list(APPEND FFLAGS -Mallocatable=03)
   link_libraries(-static-flang-libs)
 endif()
 
-# TODO should be able to run coarrays demo even in single case, may be algorithmic error in my Coarray demo code?
+
 set(DEMO_COARRAYS FALSE)
 if(${CMAKE_Fortran_COMPILER_ID} STREQUAL Intel)
-    add_compile_options(-coarray=shared)# -check all)
+    add_compile_options(-coarray=shared)
     link_libraries(-coarray=shared)
     set(DEMO_COARRAYS TRUE)
 elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU)
@@ -39,7 +47,12 @@ endif()
 
 add_library(lineclip lineclipping.f90)
 
-add_library(assert assert.f90)
+set(okcomp GNU Intel)
+if(CMAKE_Fortran_COMPILER_ID IN_LIST okcomp)
+  add_library(assert assert.f90)
+else()
+  add_library(assert assert_legacy.f90)
+endif()
 
 add_executable(RunLineclip DemoLineclip.f90)
 target_compile_options(RunLineclip PRIVATE ${FFLAGS})

DemoLineclip.f90

@@ -2,7 +2,7 @@ program test
 
     use, intrinsic:: ieee_arithmetic
     use lineclip,only: Ccohensutherland, cohensutherland
-    use assert
+    use assert, only: wp, err, assert_isclose
 
     implicit none
 
@@ -66,7 +66,7 @@ subroutine test_lineclip()
     x1=0.;y1=0.1;x2=0.;y2=0.1
 
     call cohensutherland(xmin,ymax,xmax,ymin,x1,y1,x2,y2)
-    if (.not.all(ieee_is_nan([x1,y1,x2,y2]))) error stop 'failed no intersection test'
+    if (.not.all(ieee_is_nan([x1,y1,x2,y2]))) call err('failed no intersection test')
 
     print *, 'OK lineclip'
 

assert.f90

@@ -1,13 +1,14 @@
 module assert
 
-  use, intrinsic:: iso_fortran_env, only: sp=>real32, dp=>real64, qp=>real128, stderr=>error_unit
+  use, intrinsic:: iso_c_binding, only: sp=>c_float, dp=>c_double
+  use, intrinsic:: iso_fortran_env, only: stderr=>error_unit
   use, intrinsic:: ieee_arithmetic
   implicit none
   private
 
-  integer,parameter :: wp = dp
+  integer,parameter :: wp = sp
 
-  public :: wp,isclose, assert_isclose
+  public :: wp,isclose, assert_isclose, err
 
 contains
 
@@ -31,10 +32,13 @@ elemental logical function isclose(actual, desired, rtol, atol, equal_nan)
 
   real(wp) :: r,a
   logical :: n
-
-  r = merge(rtol, 1e-5_wp, present(rtol)) 
-  a = merge(atol, 0._wp, present(atol)) 
-  n = merge(equal_nan, .false., present(equal_nan))
+  ! this is appropriate INSTEAD OF merge(), since non present values aren't defined.
+  r = 1e-5_wp
+  a = 0._wp
+  n = .false.
+  if (present(rtol)) r = rtol
+  if (present(atol)) a = atol
+  if (present(equal_nan)) n = equal_nan
 
   !print*,r,a,n,actual,desired
 
@@ -69,13 +73,19 @@ impure elemental subroutine assert_isclose(actual, desired, rtol, atol, equal_na
   real(wp), intent(in) :: actual, desired
   real(wp), intent(in), optional :: rtol, atol
   logical, intent(in), optional :: equal_nan
-  character(*), intent(in), optional :: err_msg  
- 
+  character(*), intent(in), optional :: err_msg
+
   if (.not.isclose(actual,desired,rtol,atol,equal_nan)) then
     write(stderr,*) merge(err_msg,'',present(err_msg)),': actual',actual,'desired',desired
     error stop
   endif
 
 end subroutine assert_isclose
 
+
+pure subroutine err(msg)
+  character, intent(in) :: msg
+  error stop msg
+end subroutine err
+
 end module assert

lineclipping.f90

@@ -1,12 +1,12 @@
 module lineclip
 
-use, intrinsic:: iso_c_binding, only: sp=>C_FLOAT, dp=>C_DOUBLE, c_int
+use, intrinsic:: iso_c_binding, only: c_int
 use, intrinsic:: iso_fortran_env, only : stderr=>error_unit
 use, intrinsic:: ieee_arithmetic, only: ieee_value, ieee_quiet_nan, ieee_is_nan
+use assert, only: err,wp
 
 implicit none
 
-    integer, parameter :: wp=dp
     integer,parameter :: inside=0,left=1,right=2,lower=4,upper=8
     private
     public:: wp,cohensutherland,Ccohensutherland
@@ -58,8 +58,6 @@ elemental subroutine cohensutherland(xmin,ymax,xmax,ymin, &
  nan = ieee_value(1.,ieee_quiet_nan)
 
 
-
-
 ! check for trivially outside lines
 k1 = getclip(x1,y1,xmin,xmax,ymin,ymax)
 k2 = getclip(x2,y2,xmin,xmax,ymin,ymax)
@@ -87,13 +85,13 @@ elemental subroutine cohensutherland(xmin,ymax,xmax,ymin, &
         y = y1 + (y2 - y1) * (xmin - x1) / (x2 - x1)
         x = xmin
     else
-        error stop 'undefined clipping state'
+        call err('undefined clipping state')
     endif
 
-    if (opt == k1) then
+    if (opt == k1) then ! not case select
         x1 = x; y1 = y
         k1 = getclip(x1,y1,xmin,xmax,ymin,ymax)
-    else if (opt == k2) then
+    elseif (opt == k2) then
         x2 = x; y2 = y
         k2 = getclip(x2,y2,xmin,xmax,ymin,ymax)
     endif

tests/test_all.py

@@ -1,38 +1,29 @@
 #!/usr/bin/env python
-import logging
-import unittest
-from numpy.testing import assert_array_almost_equal
-import subprocess
-from pathlib import Path
+from numpy.testing import assert_array_almost_equal,run_module_suite
 #
-from pylineclip import cohensutherland
+import pylineclip as plc
 
-path=Path(__file__).parents[1]
 
-class BasicTests(unittest.TestCase):
-    def test_lineclip(self):
-        """
-        make box with corners LL/UR (1,3) (4,5)
-        and line segment with ends (0,0) (4,6)
-        """
-        #%% LOWER to UPPER test
-        x1, y1, x2, y2 = cohensutherland(1,  5, 4, 3,
-                                         0,  0, 4, 6)
+def test_lineclip():
+    """
+    make box with corners LL/UR (1,3) (4,5)
+    and line segment with ends (0,0) (4,6)
+    """
+    #%% LOWER to UPPER test
+    x1, y1, x2, y2 = plc.cohensutherland(1,  5, 4, 3,
+                                     0,  0, 4, 6)
 
-        assert_array_almost_equal([x1,y1,x2,y2],[2, 3, 3.3333333333333,5])
-        #%% no intersection test
-        x1,y1,x2,y2 = cohensutherland(1,5,  4,3,
-                                      0,0.1,0,0.1)
-        assert x1==y1==x2==y2==None
-        #%% left to right test
-        x1,y1,x2,y2 = cohensutherland(1,5,4,3,
-                                      0,4,5,4)
-        assert_array_almost_equal([x1,y1,x2,y2],[1, 4, 4, 4])
+    assert_array_almost_equal([x1,y1,x2,y2],[2, 3, 3.3333333333333,5])
+    #%% no intersection test
+    x1,y1,x2,y2 = plc.cohensutherland(1,5,  4,3,
+                                  0,0.1,0,0.1)
+    assert x1==y1==x2==y2==None
+    #%% left to right test
+    x1,y1,x2,y2 = plc.cohensutherland(1,5,4,3,
+                                  0,4,5,4)
+    assert_array_almost_equal([x1,y1,x2,y2],[1, 4, 4, 4])
 
-    def test_fortran_lineclip(self):
-          
-        subprocess.check_call([str(path / 'bin/RunLineclip')])
 
 
 if __name__ == '__main__':
-    unittest.main()
+    run_module_suite()