bugfix: character class including only one space [ ]

Author: perazz

project/fortran-regex.depend

@@ -1,5 +1,5 @@
 # depslib dependency file v1.0
-1671301959 source:/Users/federico/code/fortran-regex/src/regex.f90
+1671311068 source:/Users/federico/code/fortran-regex/src/regex.f90
 
 1671276031 source:/Users/federico/code/fortran-regex/test/test_1.f90
 

project/regex_module.mod

@@ -73,8 +73,7 @@ module regex_module
         integer :: type = UNUSED
 
         ! Single or multi-character pattern
-        character(kind=RCK,len=MAX_CHAR_CLASS_LEN) :: ccl = repeat(' ',MAX_CHAR_CLASS_LEN)
-
+        character(kind=RCK,len=:), allocatable :: ccl
         contains
 
           procedure :: print => print_pattern
@@ -112,8 +111,9 @@ module regex_module
     ! Clean up a pattern
     elemental subroutine pat_destroy(this)
        class(regex_pattern), intent(inout) :: this
+       integer :: ierr
        this%type = UNUSED
-       this%ccl  = repeat(' ',MAX_CHAR_CLASS_LEN)
+       deallocate(this%ccl,stat=ierr)
     end subroutine pat_destroy
 
     ! Number of rules in the current pattern
@@ -147,19 +147,17 @@ end subroutine write_pattern
 
     elemental subroutine destroy(this)
         class(regex_op), intent(inout) :: this
-        integer :: i,ierr
+        integer :: i
         do i=1,MAX_REGEXP_OBJECTS
-            this%pattern(i)%type = UNUSED
-            this%pattern(i)%ccl = ''
+            call this%pattern(i)%destroy()
         end do
     end subroutine destroy
 
     subroutine finalize(this)
         type(regex_op), intent(inout) :: this
-        integer :: i,ierr
+        integer :: i
         do i=1,MAX_REGEXP_OBJECTS
-            this%pattern(i)%type = UNUSED
-            this%pattern(i)%ccl = ''
+            call this%pattern(i)%destroy()
         end do
     end subroutine finalize
 
@@ -237,7 +235,7 @@ logical function matchcharclass(c,str) result(match)
        i = 0
 
        ! All characters in the charclass contents
-       loop: do while (i<len_trim(str))
+       loop: do while (i<len(str))
 
           i = i+1
 
@@ -266,7 +264,7 @@ logical function matchcharclass(c,str) result(match)
              ! Character match
              if (c==DASH) then
                 ! If this is a range, the character must be in this range, that we evaluate with the ASCII collating sequence
-                match = i<=0 .or. i+1>len_trim(str)
+                match = i<=0 .or. i+1>len(str)
              else
                 match = .true.
              end if
@@ -408,11 +406,12 @@ subroutine new_from_pattern(this,pattern)
 
        ! Local variables
        character(len=MAX_CHAR_CLASS_LEN,kind=RCK) :: ccl_buf ! size of buffer for chars in all char-classes in the expression. */
-       integer :: loc,i,j,lenp
+       integer :: loc,i,j,lenp,lenc
        character(kind=RCK) :: c
 
        ! Initialize class
        call this%destroy()
+       ccl_buf = repeat(SPACE,MAX_CHAR_CLASS_LEN)
 
        if (DEBUG) print "('[regex] parsing pattern: <',a,'>')", trim(pattern)
 
@@ -487,6 +486,7 @@ subroutine new_from_pattern(this,pattern)
 
                 ! Remove any escape characters
                 loc = index(pattern(i+1:),']')
+                lenc = loc-1
                 if (loc>0) then
                     ccl_buf = pattern(i+1:i+loc-1)
                     i = i+loc
@@ -512,8 +512,10 @@ subroutine new_from_pattern(this,pattern)
                     end if
                 end if
 
-                ! Terminate string
-                this%pattern(j)%ccl = trim(ccl_buf)
+                ! Ensure there are no spaces
+
+                allocate(character(len=lenc,kind=RCK) :: this%pattern(j)%ccl)
+                this%pattern(j)%ccl = ccl_buf(:lenc)
 
          case default
 

project/regex_test_1.mod

@@ -506,7 +506,6 @@ logical function run_test2() result(success)
 
        integer, parameter :: NTEST = 10
        integer :: bufsize,i,length,index,bufsizes(NTEST)
-       character(kind=RCK) :: saved
 
        print *
        print *, "Testing pathological pattern '.+nonexisting.+' to force worst-case asymptotic performance:"

project/regex_test_2.mod

@@ -19,12 +19,13 @@ program tests
        call add_test(run_test1(valid,pattern,trim(str),length))
     end do
 
-    ! Test #2
-    call add_test(run_test2())
-
     ! Test #3
     call add_test(test_invalid())
     call add_test(test_main())
+    call add_test(test_bracket_space())
+
+    ! Test #2
+    call add_test(run_test2())
 
     if (nfailed<=0) then
         print *, 'SUCCESS! all tests passed.'
@@ -35,8 +36,6 @@ program tests
     end if
 
 
-
-
     contains
 
     subroutine add_test(successful_test)
@@ -73,10 +72,27 @@ logical function test_main() result(success)
        idx = REGEX(string=text,pattern='foo*',length=ln);
 
        ! Prints "football"
+       success = idx>0; if (.not.success) return
        success = text(idx:idx+ln-1) == "foo"
 
     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"
+
+    end function test_bracket_space
+
+
 
 
 end program tests