Skip to content

Commit d5ae186

Browse files
committed
now allowed to have variables with the same name as built in functions
can use both in the same expressions. Fixes #13
1 parent f2c739f commit d5ae186

File tree

2 files changed

+48
-20
lines changed

2 files changed

+48
-20
lines changed

src/function_parser.f90

Lines changed: 24 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1301,7 +1301,7 @@ recursive subroutine check_syntax (me,func,funcstr,var,ipos)
13011301
end if
13021302

13031303
end_of_function = .false.
1304-
n = mathfunction_index (func(j:))
1304+
n = mathfunction_index (func(j:), var)
13051305
if (n > 0) then ! Check for math function
13061306
j = j+len_trim(functions(n))
13071307
if (j > lFunc) then
@@ -1310,9 +1310,9 @@ recursive subroutine check_syntax (me,func,funcstr,var,ipos)
13101310
end if
13111311
c = func(j:j)
13121312
if (c /= '(') then
1313-
write(*,*) 'here', funcstr
1314-
write(*,*) 'j = ', j
1315-
write(*,*) 'c = ', c
1313+
! write(*,*) 'here', funcstr
1314+
! write(*,*) 'j = ', j
1315+
! write(*,*) 'c = ', c
13161316
call me%add_error(j, ipos, funcstr, 'Missing opening parenthesis')
13171317
return
13181318
end if
@@ -1336,8 +1336,8 @@ recursive subroutine check_syntax (me,func,funcstr,var,ipos)
13361336
call me%add_error(j, ipos, funcstr, 'Missing required function argument')
13371337
return
13381338
elseif (num_args > required_args(n) + optional_args(n)) then
1339-
call me%add_error(j, ipos, funcstr, 'Too many function arguments')
1340-
return
1339+
call me%add_error(j, ipos, funcstr, 'Too many function arguments')
1340+
return
13411341
end if
13421342

13431343
! Recursively check each argument substring.
@@ -1516,11 +1516,12 @@ end function operator_index
15161516
!>
15171517
! Return index of math function beginning at 1st position of string `str`
15181518

1519-
function mathfunction_index (str) result (n)
1519+
function mathfunction_index (str, var) result (n)
15201520

15211521
implicit none
15221522

15231523
character(len=*), intent(in) :: str
1524+
character(len=*), dimension(:),intent(in) :: var !! array with variable names
15241525
integer :: n
15251526

15261527
integer :: j
@@ -1537,6 +1538,19 @@ function mathfunction_index (str) result (n)
15371538
end if
15381539
end do
15391540

1541+
if (n>0) then
1542+
if (any(functions(n) == var)) then
1543+
! in this case, there is a variable with the same
1544+
! name as this function. So, check to make sure this
1545+
! is really the function.
1546+
if (k+1<=len(str)) then
1547+
if (str(k+1:k+1) /= '(') then ! this assumes that spaces have been removed
1548+
n = 0 ! assume it is the variable
1549+
end if
1550+
end if
1551+
end if
1552+
end if
1553+
15401554
end function mathfunction_index
15411555
!*******************************************************************************
15421556

@@ -1785,8 +1799,8 @@ function completely_enclosed (f, b, e) result (res)
17851799

17861800
character (len=*), intent(in) :: f !! function substring
17871801
integer, intent(in) :: b,e !! first and last pos. of substring
1788-
17891802
logical :: res
1803+
17901804
integer :: j,k
17911805

17921806
res=.false.
@@ -1836,7 +1850,7 @@ recursive subroutine compile_substr (me, f, b, e, var)
18361850
call compile_substr (me, f, b+1, e-1, var)
18371851
return
18381852
elseif (scan(f(b:b),calpha) > 0) then
1839-
n = mathfunction_index (f(b:e))
1853+
n = mathfunction_index (f(b:e), var)
18401854
if (n > 0) then
18411855
b2 = b+index(f(b:e),'(')-1
18421856
if (completely_enclosed(f, b2, e)) then ! case 3: f(b:e) = 'fcn(...)'
@@ -1868,7 +1882,7 @@ recursive subroutine compile_substr (me, f, b, e, var)
18681882
call add_compiled_byte (me, cneg)
18691883
return
18701884
elseif (scan(f(b+1:b+1),calpha) > 0) then
1871-
n = mathfunction_index (f(b+1:e))
1885+
n = mathfunction_index (f(b+1:e), var)
18721886
if (n > 0) then
18731887
b2 = b+index(f(b+1:e),'(')
18741888
if (completely_enclosed(f, b2, e)) then ! case 5: f(b:e) = '-fcn(...)'

test/tests.f90

Lines changed: 24 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -254,16 +254,22 @@ end subroutine fptest5
254254
!*******************************************************************************
255255

256256
!*******************************************************************************
257+
!>
258+
!
259+
!### Notes
260+
! * This one has cases where a variable has the same name as a built-in function.
261+
! So, for some expressions we want the function, and others we want the variable.
262+
257263
subroutine fptest6()
258264

259265
implicit none
260266

261-
integer, parameter :: nfunc = 14
267+
integer, parameter :: nfunc = 17
262268
character (len=*), dimension(nfunc), parameter :: func = [ '-1.0*x ', &
263269
'-sqrt(x) ', &
264270
'a*COS(b*x)+5 ', &
265271
'a*COS(b*x)+5.0 ', &
266-
'exp(x)-abs(x)+log(1.0)+log10(1.0)',&
272+
'exp(x)-abs(x)+log(1.0)+log10(1.0)', &
267273
'sinh(x) ', &
268274
'cosh(x) ', &
269275
'tanh(x) ', &
@@ -272,18 +278,22 @@ subroutine fptest6()
272278
'acos(y) ', &
273279
'atan(y) ', &
274280
'-x**2 ', &
275-
'-x^2 ' ]
276-
integer, parameter :: nvar = 4
277-
character (len=*), dimension(nvar), parameter :: var = [ 'x', &
278-
'a', &
279-
'b', &
280-
'y' ]
281-
real(wp), dimension(nvar), parameter :: val = [ 2.0_wp, 3.0_wp, 4.0_wp, 0.1_wp ]
281+
'-x^2 ', &
282+
'sin(x) ', &
283+
'sin*2 ', &
284+
'2*(sin)*sin+1-sin(x) ' ]
285+
integer, parameter :: nvar = 5
286+
character (len=*), dimension(nvar), parameter :: var = [ 'x ', &
287+
'a ', &
288+
'b ', &
289+
'y ', &
290+
'sin' ] !! sin is a built-in function
291+
real(wp), dimension(nvar), parameter :: val = [ 2.0_wp, 3.0_wp, 4.0_wp, 0.1_wp, 1.0_wp ]
282292

283293
type(fparser_array) :: parser
284294
real(wp),dimension(nfunc) :: res
285295
integer :: i !! counter
286-
real(wp) :: x,a,b,y
296+
real(wp) :: x,a,b,y,s
287297

288298
write(*,*) ''
289299
write(*,*) ' Test 6'
@@ -304,6 +314,7 @@ subroutine fptest6()
304314
a = val(2)
305315
b = val(3)
306316
y = val(4)
317+
s = val(5)
307318
call compare(func(1), -1.0_wp*x, res(1))
308319
call compare(func(2), -sqrt(x), res(2))
309320
call compare(func(3), a*cos(b*x)+5, res(3))
@@ -318,6 +329,9 @@ subroutine fptest6()
318329
call compare(func(12), atan(y), res(12))
319330
call compare(func(13), -x**2, res(13))
320331
call compare(func(14), -x**2, res(14))
332+
call compare(func(15), sin(x), res(15))
333+
call compare(func(16), 2.0_wp, res(16))
334+
call compare(func(17), 2*(s)*s+1-sin(x), res(17))
321335
end if
322336

323337
end subroutine fptest6

0 commit comments

Comments
 (0)