BUGFIX: broken/missing Fortran code/unit tests

This commit is contained in:
Michael Hirsch, Ph.D 2019-01-27 13:57:21 -05:00 committed by Jussi Pakkanen
parent 3fc8a0dc41
commit 8636f31d9c
18 changed files with 139 additions and 111 deletions

View File

@ -19,6 +19,7 @@ import subprocess
import functools import functools
import itertools import itertools
from pathlib import Path from pathlib import Path
from typing import List
from .. import mlog from .. import mlog
from .. import coredata from .. import coredata
@ -456,7 +457,7 @@ class CCompiler(Compiler):
return self.compiles(code, env, extra_args=extra_args, return self.compiles(code, env, extra_args=extra_args,
dependencies=dependencies, mode='link') dependencies=dependencies, mode='link')
def run(self, code, env, *, extra_args=None, dependencies=None): def run(self, code: str, env, *, extra_args=None, dependencies=None):
if self.is_cross and self.exe_wrapper is None: if self.is_cross and self.exe_wrapper is None:
raise CrossNoRunException('Can not run test applications in this cross environment.') raise CrossNoRunException('Can not run test applications in this cross environment.')
with self._build_wrapper(code, env, extra_args, dependencies, mode='link', want_output=True) as p: with self._build_wrapper(code, env, extra_args, dependencies, mode='link', want_output=True) as p:
@ -978,7 +979,7 @@ class CCompiler(Compiler):
return [f.as_posix()] return [f.as_posix()]
@staticmethod @staticmethod
def _get_file_from_list(files): def _get_file_from_list(files: List[str]) -> str:
for f in files: for f in files:
if os.path.isfile(f): if os.path.isfile(f):
return f return f

View File

@ -1795,7 +1795,7 @@ class ArmclangCompiler:
EnvironmentException('armlink version string not found') EnvironmentException('armlink version string not found')
# Using the regular expression from environment.search_version, # Using the regular expression from environment.search_version,
# which is used for searching compiler version # which is used for searching compiler version
version_regex = '(?<!(\d|\.))(\d{1,2}(\.\d+)+(-[a-zA-Z0-9]+)?)' version_regex = r'(?<!(\d|\.))(\d{1,2}(\.\d+)+(-[a-zA-Z0-9]+)?)'
linker_ver = re.search(version_regex, ver_str) linker_ver = re.search(version_regex, ver_str)
if linker_ver: if linker_ver:
linker_ver = linker_ver.group(0) linker_ver = linker_ver.group(0)

View File

@ -11,6 +11,8 @@
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and # See the License for the specific language governing permissions and
# limitations under the License. # limitations under the License.
from typing import List
import subprocess, os
from .c import CCompiler from .c import CCompiler
from .compilers import ( from .compilers import (
@ -29,7 +31,7 @@ from .compilers import (
) )
from mesonbuild.mesonlib import EnvironmentException, is_osx from mesonbuild.mesonlib import EnvironmentException, is_osx
import subprocess, os
class FortranCompiler(Compiler): class FortranCompiler(Compiler):
library_dirs_cache = CCompiler.library_dirs_cache library_dirs_cache = CCompiler.library_dirs_cache
@ -228,7 +230,7 @@ end program prog
dependencies=dependencies) dependencies=dependencies)
def run(self, code, env, *, extra_args=None, dependencies=None): def run(self, code, env, *, extra_args=None, dependencies=None):
return CCompiler.run(self, code, env, extra_args, dependencies) return CCompiler.run(self, code, env, extra_args=extra_args, dependencies=dependencies)
def _get_patterns(self, *args, **kwargs): def _get_patterns(self, *args, **kwargs):
return CCompiler._get_patterns(self, *args, **kwargs) return CCompiler._get_patterns(self, *args, **kwargs)
@ -263,6 +265,13 @@ end program prog
def has_multi_arguments(self, args, env): def has_multi_arguments(self, args, env):
return CCompiler.has_multi_arguments(self, args, env) return CCompiler.has_multi_arguments(self, args, env)
@classmethod
def _get_trials_from_pattern(cls, pattern, directory, libname):
return CCompiler._get_trials_from_pattern(pattern, directory, libname)
@staticmethod
def _get_file_from_list(files) -> List[str]:
return CCompiler._get_file_from_list(files)
class GnuFortranCompiler(GnuCompiler, FortranCompiler): class GnuFortranCompiler(GnuCompiler, FortranCompiler):
def __init__(self, exelist, version, compiler_type, is_cross, exe_wrapper=None, defines=None, **kwargs): def __init__(self, exelist, version, compiler_type, is_cross, exe_wrapper=None, defines=None, **kwargs):

View File

@ -321,7 +321,7 @@ def search_version(text):
# This regex is reaching magic levels. If it ever needs # This regex is reaching magic levels. If it ever needs
# to be updated, do not complexify but convert to something # to be updated, do not complexify but convert to something
# saner instead. # saner instead.
version_regex = '(?<!(\d|\.))(\d{1,2}(\.\d+)+(-[a-zA-Z0-9]+)?)' version_regex = r'(?<!(\d|\.))(\d{1,2}(\.\d+)+(-[a-zA-Z0-9]+)?)'
match = re.search(version_regex, text) match = re.search(version_regex, text)
if match: if match:
return match.group(0) return match.group(0)

View File

@ -5304,11 +5304,15 @@ class NativeFileTests(BasePlatformTests):
if comp.id == 'gcc': if comp.id == 'gcc':
if shutil.which('ifort'): if shutil.which('ifort'):
return 'ifort', 'intel' return 'ifort', 'intel'
elif shutil.which('flang'):
return 'flang', 'flang'
elif shutil.which('pgfortran'):
return 'pgfortran', 'pgi'
# XXX: there are several other fortran compilers meson # XXX: there are several other fortran compilers meson
# supports, but I don't have any of them to test with # supports, but I don't have any of them to test with
raise unittest.SkipTest('No alternate Fortran implementation.') raise unittest.SkipTest('No alternate Fortran implementation.')
if not shutil.which('gfortran'): if not shutil.which('gfortran'):
raise unittest.SkipTest('No alternate C# implementation.') raise unittest.SkipTest('No alternate Fortran implementation.')
return 'gfortran', 'gcc' return 'gfortran', 'gcc'
self.helper_for_compiler('fortran', cb) self.helper_for_compiler('fortran', cb)

View File

@ -1,6 +1,9 @@
project('simple fortran', 'fortran') project('simple fortran', 'fortran')
add_global_arguments('-fbounds-check', language : 'fortran') fc = meson.get_compiler('fortran')
if fc == 'gcc'
add_global_arguments('-fbounds-check', language : 'fortran')
endif
e = executable('simple', 'simple.f90', e = executable('simple', 'simple.f90',
fortran_args : '-ffree-form') fortran_args : '-ffree-form')

View File

@ -1,32 +1,32 @@
module gzip module gzip
interface use iso_c_binding, only: c_char, c_ptr, c_int
function gzopen(path, mode) bind(C) implicit none
use iso_c_binding, only: c_char, c_ptr
implicit none
character(c_char), intent(in) :: path(*), mode(*)
type(c_ptr) :: gzopen
end function gzopen
end interface
interface interface
function gzwrite(file, buf, len) bind(C) type(c_ptr) function gzopen(path, mode) bind(C)
use iso_c_binding, only: c_int, c_ptr import c_char, c_ptr
implicit none
type(c_ptr), value, intent(in) :: file
type(*), intent(in) :: buf
integer(c_int), value, intent(in) :: len
integer(c_int) :: gzwrite
end function gzwrite
end interface
interface character(kind=c_char), intent(in) :: path(*), mode(*)
function gzclose(file) bind(C) end function gzopen
use iso_c_binding, only: c_int, c_ptr end interface
implicit none
type(c_ptr), value, intent(in) :: file interface
integer(c_int) :: gzclose integer(c_int) function gzwrite(file, buf, len) bind(C)
end function gzclose import c_int, c_ptr, c_char
end interface
type(c_ptr), value, intent(in) :: file
character(kind=c_char), intent(in) :: buf
integer(c_int), value, intent(in) :: len
end function gzwrite
end interface
interface
integer(c_int) function gzclose(file) bind(C)
import c_int, c_ptr
type(c_ptr), value, intent(in) :: file
end function gzclose
end interface
end module gzip end module gzip

View File

@ -1,40 +1,38 @@
program main
use iso_c_binding, only: c_int, c_char, c_null_char, c_ptr use iso_fortran_env, only: stderr=>error_unit
use gzip, only: gzopen, gzwrite, gzclose use iso_c_binding, only: c_int, c_char, c_null_char, c_ptr
use gzip, only: gzopen, gzwrite, gzclose
implicit none implicit none
character(kind=c_char,len=*), parameter :: path = & character(kind=c_char,len=*), parameter :: path = c_char_"test.gz"//c_null_char
c_char_"test.gz"//c_null_char character(kind=c_char,len=*), parameter :: mode = c_char_"wb9"//c_null_char
character(kind=c_char,len=*), parameter :: mode = & integer(c_int), parameter :: buffer_size = 512
c_char_"wb9"//c_null_char
integer(c_int), parameter :: buffer_size = 512
type(c_ptr) :: file type(c_ptr) :: file
character(len=buffer_size) :: buffer character(kind=c_char, len=buffer_size) :: buffer
integer(c_int) :: ret integer(c_int) :: ret
integer :: i integer :: i
! open file ! open file
file = gzopen(path, mode) file = gzopen(path, mode)
! fill buffer with data ! fill buffer with data
do i=1,buffer_size/4 do i=1,buffer_size/4
write(buffer(4*(i-1)+1:4*i), '(i3.3, a)') i, new_line('') write(buffer(4*(i-1)+1:4*i), '(i3.3, a)') i, new_line('')
end do end do
ret = gzwrite(file, buffer, buffer_size) ret = gzwrite(file, buffer, buffer_size)
if (ret.ne.buffer_size) then if (ret /= buffer_size) then
write(*,'(a, i3, a, i3, a)') 'Error: ', ret, ' / ', buffer_size, & write(stderr,'(a, i3, a, i3, a)') 'Error: ', ret, ' / ', buffer_size, &
' bytes written.' ' bytes written.'
stop 1 stop 1
end if end if
! close file ! close file
ret = gzclose(file) ret = gzclose(file)
if (ret.ne.0) then if (ret /= 0) then
print *, 'Error: failure to close file with error code ', ret write(stderr,*) 'Error: failure to close file with error code ', ret
stop 1 stop 1
end if end if
end program main end program

View File

@ -1,11 +1,18 @@
MODULE Circle MODULE geom
REAL, PARAMETER :: Pi = 3.1415927
type :: circle
REAL :: Pi = 4.*atan(1.)
REAL :: radius REAL :: radius
END MODULE Circle end type circle
END MODULE geom
PROGRAM prog PROGRAM prog
use Circle use geom, only : circle
IMPLICIT NONE IMPLICIT NONE
type(circle) :: ell
ell%radius = 3.
END PROGRAM prog END PROGRAM prog

View File

@ -1,6 +1,6 @@
program hello
use static_hello
implicit none
call static_say_hello() use static_hello
end program hello implicit none
call static_say_hello()
end program

View File

@ -1,17 +1,17 @@
module static_hello module static_hello
implicit none implicit none
private private
public :: static_say_hello public :: static_say_hello
interface static_say_hello interface static_say_hello
module procedure say_hello module procedure say_hello
end interface static_say_hello end interface static_say_hello
contains contains
subroutine say_hello subroutine say_hello
print *, "Static library called." print *, "Static library called."
end subroutine say_hello end subroutine say_hello
end module static_hello end module static_hello

View File

@ -1,17 +1,17 @@
module dynamic module dynamic
implicit none implicit none
private private
public :: hello public :: hello
interface hello interface hello
module procedure say module procedure say
end interface hello end interface hello
contains contains
subroutine say subroutine say
print *, "Hello, hello..." print *, "Hello from shared library."
end subroutine say end subroutine say
end module dynamic end module dynamic

View File

@ -1,6 +1,5 @@
program main use dynamic, only: hello
use dynamic implicit none
implicit none
call hello() call hello()
end program main end program

View File

@ -1,6 +1,6 @@
module MyMod1 module MyMod1
implicit none implicit none
integer, parameter :: myModVal1 = 1 integer, parameter :: myModVal1 = 1
end module MyMod1 end module MyMod1

View File

@ -1,6 +1,6 @@
module mymod2 module mymod2
implicit none implicit none
integer, parameter :: myModVal2 = 2 integer, parameter :: myModVal2 = 2
end module mymod2 end module mymod2

View File

@ -1,7 +1,8 @@
program test use mymod1
use mymod1 use MyMod2
use MyMod2
integer, parameter :: testVar = myModVal1 + myModVal2 implicit none
end program test integer, parameter :: testVar = myModVal1 + myModVal2
end program

View File

@ -1,5 +1,11 @@
function fortran() bind(C) function fortran() bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding, only: dp=>c_double
real(kind=c_double) :: fortran implicit none
fortran = 2.0**rand(1)
real(dp) :: r, fortran
call random_number(r)
fortran = 2._dp**r
end function fortran end function fortran

View File

@ -15,7 +15,7 @@ endif
e = executable( e = executable(
'cppfort', 'cppfort',
['main.cpp', 'fortran.f'], ['main.cpp', 'fortran.f'],
dependencies : [link_with], dependencies : link_with,
) )
test('C++ FORTRAN', e) test('C++ FORTRAN', e)