Skip to content

Commit a7459c4

Browse files
jacobwilliamsjacobwilliams
authored
Merge pull request #7 from jacobwilliams/tests
Tests
2 parents 49a617e + d0a073e commit a7459c4

File tree

2 files changed

+106
-11
lines changed

2 files changed

+106
-11
lines changed

‎src/function_parser.f90

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1405,6 +1405,8 @@ function mathitem_index (me, f, var) result (n)
14051405
integer :: n !! byte value of math item
14061406

14071407
n = 0
1408+
if (len(f)==0) return ! error condition
1409+
14081410
if (scan(f(1:1),'0123456789.') > 0) then ! check for begin of a number
14091411
me%immedsize = me%immedsize + 1
14101412
if (allocated(me%immed)) then

‎test/tests.f90

Lines changed: 104 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ program tests
1616
call fptest4()
1717
call fptest5()
1818
call fptest6()
19+
call error_tests()
1920

2021
contains
2122
!*******************************************************************************
@@ -257,22 +258,30 @@ subroutine fptest6()
257258

258259
implicit none
259260

260-
integer, parameter :: nfunc = 5
261+
integer, parameter :: nfunc = 12
261262
character (len=*), dimension(nfunc), parameter :: func = [ '-1.0*x ', &
262263
'-sqrt(x) ', &
263264
'a*COS(b*x)+5 ', &
264265
'a*COS(b*x)+5.0 ', &
265-
'exp(x)-abs(x)+log(1.0)+log10(1.0)' ]
266-
integer, parameter :: nvar = 3
266+
'exp(x)-abs(x)+log(1.0)+log10(1.0)',&
267+
'sinh(x) ', &
268+
'cosh(x) ', &
269+
'tanh(x) ', &
270+
'tan(x) ', &
271+
'asin(y) ', &
272+
'acos(y) ', &
273+
'atan(y) ' ]
274+
integer, parameter :: nvar = 4
267275
character (len=*), dimension(nvar), parameter :: var = [ 'x', &
268276
'a', &
269-
'b' ]
270-
real(wp), dimension(nvar), parameter :: val = [ 2.0_wp, 3.0_wp, 4.0_wp ]
277+
'b', &
278+
'y' ]
279+
real(wp), dimension(nvar), parameter :: val = [ 2.0_wp, 3.0_wp, 4.0_wp, 0.1_wp ]
271280

272281
type(fparser_array) :: parser
273282
real(wp),dimension(nfunc) :: res
274283
integer :: i !! counter
275-
real(wp) :: x,a,b
284+
real(wp) :: x,a,b,y
276285

277286
write(*,*) ''
278287
write(*,*) ' Test 6'
@@ -292,16 +301,100 @@ subroutine fptest6()
292301
x = val(1)
293302
a = val(2)
294303
b = val(3)
295-
call compare(func(1), -1.0_wp*x, res(1))
296-
call compare(func(2), -sqrt(x), res(2))
297-
call compare(func(3), a*cos(b*x)+5, res(3))
298-
call compare(func(4), a*cos(b*x)+5.0, res(4))
299-
call compare(func(5), exp(x)-abs(x)+log(1.0)+log10(1.0), res(5))
304+
y = val(4)
305+
call compare(func(1), -1.0_wp*x, res(1))
306+
call compare(func(2), -sqrt(x), res(2))
307+
call compare(func(3), a*cos(b*x)+5, res(3))
308+
call compare(func(4), a*cos(b*x)+5.0, res(4))
309+
call compare(func(5), exp(x)-abs(x)+log(1.0)+log10(1.0), res(5))
310+
call compare(func(6), sinh(x), res(6))
311+
call compare(func(7), cosh(x), res(7))
312+
call compare(func(8), tanh(x), res(8))
313+
call compare(func(9), tan(x), res(9))
314+
call compare(func(10), asin(y), res(10))
315+
call compare(func(11), acos(y), res(11))
316+
call compare(func(12), atan(y), res(12))
300317
end if
301318

302319
end subroutine fptest6
303320
!*******************************************************************************
304321

322+
!*******************************************************************************
323+
!>
324+
! Test some of the error cases.
325+
326+
subroutine error_tests()
327+
328+
implicit none
329+
330+
integer, parameter :: nvar = 3
331+
character (len=*), dimension(nvar), parameter :: var = [ 'x', &
332+
'a', &
333+
'b' ]
334+
real(wp), dimension(nvar), parameter :: val = [ 2.0_wp, 3.0_wp, 4.0_wp ]
335+
type(fparser_array) :: parser
336+
337+
write(*,*) ''
338+
write(*,*) ' Test 7 - Test error conditions'
339+
write(*,*) ''
340+
341+
call parse_error(parser,'st(-x)',var,val)
342+
call parse_error(parser,'x * 452d3234.2323',var,val)
343+
call parse_error(parser,'x * (123',var,val)
344+
call parse_error(parser,'x +-* y',var,val)
345+
call parse_error(parser,'x + sin',var,val)
346+
call parse_error(parser,'-(1) + (+x) + ()',var,val)
347+
call parse_error(parser,'x +',var,val)
348+
349+
call eval_error(parser,'sqrt(-x)',var,val)
350+
call eval_error(parser,'acos(10.0)',var,val)
351+
call eval_error(parser,'asin(10.0)',var,val)
352+
call eval_error(parser,'log(-x)',var,val)
353+
call eval_error(parser,'log10(-x)',var,val)
354+
call eval_error(parser,'1/0',var,val)
355+
356+
end subroutine error_tests
357+
!*******************************************************************************
358+
359+
subroutine parse_error(parser,str,var,val)
360+
type(fparser_array),intent(inout) :: parser
361+
character(len=*),intent(in) :: str !! expression with a parsing error
362+
real(wp),dimension(1) :: res
363+
character(len=*),dimension(:),intent(in) :: var
364+
real(wp),dimension(:),intent(in) :: val
365+
call parser%parse([str], var) ! parse and bytecompile function string
366+
if (parser%error()) then
367+
call parser%print_errors(output_unit)
368+
write(*,*) 'PASSED : parsing error'
369+
else
370+
error stop 'FAILED : there should have been a parsing error'
371+
end if
372+
call parser%clear_errors()
373+
call parser%destroy()
374+
end subroutine parse_error
375+
376+
subroutine eval_error(parser,str,var,val)
377+
type(fparser_array),intent(inout) :: parser
378+
character(len=*),intent(in) :: str !! expression with a parsing error
379+
real(wp),dimension(1) :: res
380+
character(len=*),dimension(:),intent(in) :: var
381+
real(wp),dimension(:),intent(in) :: val
382+
call parser%parse([str], var, .True.) ! parse and bytecompile function string [case sensitive]
383+
if (parser%error()) then
384+
call parser%print_errors(output_unit)
385+
error stop
386+
end if
387+
call parser%evaluate(val,res) ! interprete bytecode representation of function
388+
if (parser%error()) then
389+
call parser%print_errors(output_unit)
390+
write(*,*) 'PASSED : evaluation errors detected'
391+
else
392+
error stop 'FAILED : there should have been evaluation errors'
393+
end if
394+
call parser%clear_errors()
395+
call parser%destroy()
396+
end subroutine eval_error
397+
305398
!*******************************************************************************
306399
!>
307400
! Compare the results from the parser to the actualy expression

0 commit comments

Comments
 (0)