bugfix end anchor behavior

Author: perazz

.gitignore

@@ -0,0 +1,2 @@
+
+*.mod

project/fortran-regex.depend

@@ -1,5 +1,5 @@
 # depslib dependency file v1.0
-1671311068 source:/Users/federico/code/fortran-regex/src/regex.f90
+1671351900 source:/Users/federico/code/fortran-regex/src/regex.f90
 
 1671276031 source:/Users/federico/code/fortran-regex/test/test_1.f90
 
@@ -11,5 +11,5 @@
 
 1671123384 source:i:\fortran-regex\test\test_1.f90
 
-1671275983 source:/Users/federico/code/fortran-regex/test/test_2.f90
+1671311161 source:/Users/federico/code/fortran-regex/test/test_2.f90
 

src/regex.f90

@@ -21,6 +21,7 @@ module regex_module
  private
 
  public :: parse_pattern
+ public :: check_pattern
  public :: regex
 
  ! Character kind
@@ -108,6 +109,29 @@ module regex_module
 
  contains
 
+ ! Check that a pattern matches the expected result
+ logical function check_pattern(string,pattern,expected) result(success)
+ character(len=*,kind=RCK), intent(in) :: string
+ character(len=*,kind=RCK), intent(in) :: pattern
+ character(len=*,kind=RCK), intent(in) :: expected
+
+ integer :: idx,length
+
+ idx = regex(string,pattern,length)
+
+ if (idx>0) then
+ success = length==len(expected)
+ if (success) success = string(idx:idx+length-1)==expected
+ else
+ success = len(expected)<=0
+ end if
+
+ if (DEBUG .and. .not.success) &
+ print "('[regex] test FAILED: text=',a,' pattern=',a,' index=',i0,' len=',i0)", &
+ string,pattern,idx,length
+
+ end function check_pattern
+
  ! Clean up a pattern
  elemental subroutine pat_destroy(this)
  class(regex_pattern), intent(inout) :: this
@@ -332,7 +356,6 @@ logical function matchstar(p, pattern, text, it0, matchlength)
  it = it-1
  if (matchstar) return
  matchlength = matchlength-1
-
  end do
 
  matchlength = prelen
@@ -586,24 +609,24 @@ integer function re_matchp_nolength(string, pattern) result(index)
  end function re_matchp_nolength
 
 
- integer function re_matchp(string, pattern, matchlength) result(index)
+ integer function re_matchp(string, pattern, length) result(index)
  type(regex_op), intent(in) :: pattern
  character(len=*,kind=RCK), intent(in) :: string
- integer, intent(out) :: matchlength
-
- matchlength = 0
+ integer, intent(out) :: length
 
  if (pattern%n>0) then
 
  if (pattern%pattern(1)%type == BEGIN_WITH) then
 
  ! String must begin with this pattern
- index = merge(1,0,matchpattern(pattern%pattern(2:), string, matchlength))
+ length = 0
+ index = merge(1,0,matchpattern(pattern%pattern(2:), string, length))
 
  else
 
  do index=1,len(string)
- if (matchpattern(pattern%pattern,string(index:),matchlength)) return
+ length = 0
+ if (matchpattern(pattern%pattern,string(index:),length)) goto 1
  end do
 
  index = 0
@@ -616,6 +639,13 @@ integer function re_matchp(string, pattern, matchlength) result(index)
 
  end if
 
+ 1 if (DEBUG) then
+ if (index==0) then
+ print "('[regex] end: pattern not found. ')"
+ else
+ print "('[regex] end: pattern found at ',i0,': ',a)", index,string(index:)
+ end if
+ end if
 
  end function re_matchp
 
@@ -651,16 +681,17 @@ logical function matchpattern(pattern, text, matchlength) result(match)
 
  elseif (pattern(ip)%type == END_WITH .and. pattern(ip+1)%type == UNUSED) then
 
+ if (DEBUG .and. len(text(it:))>0) print *, '[regex] at end: remaining = ',text(it:),' len=',matchlength
 
- match = len(text(it:))<=1
+ match = it>len(text)
  return
 
  end if
 
- matchlength = matchlength+1
-
  if (it>len(text)) exit iterate
 
+ matchlength = matchlength+1
+
  if (DEBUG) print "('[regex] matching ',i0,'-th pattern on chunk <',i0,':',i0,'>')", ip,it,len(text)
  if (.not. pat_match(pattern(ip), text(it:it))) exit iterate
  ip = ip+1

test/tests.f90

@@ -23,6 +23,7 @@ program tests
  call add_test(test_invalid())
  call add_test(test_main())
  call add_test(test_bracket_space())
+ call add_test(test_end_anchor())
 
  ! Test #2
  call add_test(run_test2())
@@ -66,39 +67,41 @@ logical function test_main() result(success)
  use regex_module
  implicit none
 
- integer :: idx,ln
  character(*), parameter :: text = 'table football'
 
- idx = REGEX(string=text,pattern='foo*',length=ln);
-
- ! Prints "football"
- success = idx>0; if (.not.success) return
- success = text(idx:idx+ln-1) == "foo"
+ success = check_pattern(text,'foo*',expected="foo")
+ if (.not.success) return
 
  end function test_main
 
  logical function test_bracket_space() result(success)
  use regex_module
  implicit none
 
- integer :: idx,ln
  character(*), parameter :: text = 'table football'
 
- idx = REGEX(string=text,pattern='e[ ]f',length=ln);
-
- ! Prints "football"
- success = idx>0; if (.not.success) return
- success = text(idx:idx+ln-1) == "e f"
+ success = check_pattern(text,'e[ ]f',expected="e f")
+ if (.not.success) return
 
- idx = REGEX(string=text,pattern='e[ ]+f',length=ln);
+ success = check_pattern(text,'e[ ]+f',expected="e f")
+ if (.not.success) return
 
- ! Prints "football"
- success = idx>0; if (.not.success) return
- success = text(idx:idx+ln-1) == "e f"
 
  end function test_bracket_space
 
+ logical function test_end_anchor() result(success)
+ use regex_module
+ implicit none
+
+ character(*), parameter :: text = 'table football'
+
+ success = check_pattern(text,'ll$',expected="ll")
+ if (.not.success) return
+
+ success = check_pattern(text,'l$',expected="l")
+ if (.not.success) return
 
+ end function test_end_anchor
 
 
 end program tests