finish fixing code; add test 2

Author: perazz

project/fortran-regex.cbp

@@ -40,11 +40,14 @@
 			<Option weight="0" />
 		</Unit>
 		<Unit filename="../test/test_1.f90">
-			<Option weight="1" />
+			<Option weight="2" />
 		</Unit>
-		<Unit filename="../test/testdata.f90">
+		<Unit filename="../test/test_2.f90">
 			<Option weight="0" />
 		</Unit>
+		<Unit filename="../test/testdata.f90">
+			<Option weight="1" />
+		</Unit>
 		<Extensions />
 	</Project>
 </CodeBlocks_project_file>

project/fortran-regex.depend

@@ -1,13 +1,15 @@
 # depslib dependency file v1.0
-1662208721 source:/Users/federico/code/fortran-regex/src/regex.f90
+1671275921 source:/Users/federico/code/fortran-regex/src/regex.f90
 
-1662208720 source:/Users/federico/code/fortran-regex/test/test_1.f90
+1671276031 source:/Users/federico/code/fortran-regex/test/test_1.f90
 
-1662208326 source:/Users/federico/code/fortran-regex/test/testdata.f90
+1671272275 source:/Users/federico/code/fortran-regex/test/testdata.f90
 
 1671127283 source:i:\fortran-regex\test\testdata.f90
 
 1671125468 source:i:\fortran-regex\src\regex.f90
 
 1671123384 source:i:\fortran-regex\test\test_1.f90
 
+1671275983 source:/Users/federico/code/fortran-regex/test/test_2.f90
+

project/fortran-regex.layout

@@ -2,19 +2,19 @@
 <CodeBlocks_layout_file>
 	<FileVersion major="1" minor="0" />
 	<ActiveTarget name="Debug" />
-	<File name="..\src\regex.f90" open="1" top="1" tabpos="2" split="0" active="1" splitpos="0" zoom_1="1" zoom_2="0">
+	<File name="../src/regex.f90" open="0" top="0" tabpos="2" split="0" active="1" splitpos="0" zoom_1="1" zoom_2="0">
 		<Cursor>
-			<Cursor1 position="12313" topLine="321" />
+			<Cursor1 position="18216" topLine="639" />
 		</Cursor>
 	</File>
-	<File name="..\test\testdata.f90" open="1" top="0" tabpos="3" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
+	<File name="../test/testdata.f90" open="1" top="0" tabpos="4" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
 		<Cursor>
-			<Cursor1 position="1106" topLine="3" />
+			<Cursor1 position="449" topLine="0" />
 		</Cursor>
 	</File>
-	<File name="..\test\test_1.f90" open="1" top="0" tabpos="1" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
+	<File name="../test/test_1.f90" open="1" top="1" tabpos="1" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
 		<Cursor>
-			<Cursor1 position="575" topLine="0" />
+			<Cursor1 position="2640" topLine="83" />
 		</Cursor>
 	</File>
 </CodeBlocks_layout_file>

project/regex.mod

@@ -16,6 +16,7 @@
 !
 ! *************************************************************************************************
 module regex_module
+    use iso_fortran_env, only: output_unit
     implicit none
     private
 
@@ -28,7 +29,9 @@ module regex_module
     logical, parameter, public :: RE_DOT_MATCHES_NEWLINE = .true. ! Define .false. if you DON'T want '.' to match '\r' + '\n'
     integer, parameter, public :: MAX_REGEXP_OBJECTS = 512        ! Max number of regex symbols in expression.
     integer, parameter, public :: MAX_CHAR_CLASS_LEN = 1024       ! Max length of character-class buffer in.
-    logical, parameter :: DEBUG = .true.
+
+    ! Turn on verbosity for debugging
+    logical, parameter :: DEBUG = .false.
 
     ! Supported patterns
     integer, parameter :: UNUSED         = 0
@@ -56,12 +59,12 @@ module regex_module
     character(kind=RCK,len=*), parameter :: lowercase="abcdefghijklmnopqrstuvwxyz"
     character(kind=RCK,len=*), parameter :: uppercase="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 
-    character(kind=RCK), parameter :: UNDERSCORE = "_"
-    character(kind=RCK), parameter :: SPACE      = " "
-    character(kind=RCK), parameter :: DASH       = "-"
-    character(kind=RCK), parameter :: BACKSLASH0 = achar( 0,kind=RCK)  ! \0 or null character
-    character(kind=RCK), parameter :: NEWLINE    = achar(10,kind=RCK)  ! \n or line feed
-    character(kind=RCK), parameter :: BACKSPCE   = achar( 8,kind=RCK)  ! \b or backspace character
+    character(kind=RCK), parameter, public :: UNDERSCORE = "_"
+    character(kind=RCK), parameter, public :: SPACE      = " "
+    character(kind=RCK), parameter, public :: DASH       = "-"
+    character(kind=RCK), parameter, public :: CNULL      = achar( 0,kind=RCK)  ! \0 or null character
+    character(kind=RCK), parameter, public :: NEWLINE    = achar(10,kind=RCK)  ! \n or line feed
+    character(kind=RCK), parameter, public :: BACKSPCE   = achar( 8,kind=RCK)  ! \b or backspace character
 
 
     ! Regex pattern element
@@ -87,18 +90,20 @@ module regex_module
 
         contains
 
-           !procedure :: parse => parse_pattern
-           procedure :: write => write_pattern
+           procedure :: new     => new_from_pattern
+           procedure :: write   => write_pattern
            procedure :: nrules
            procedure :: destroy
-           final :: finalize
+           final     :: finalize
 
     end type regex_op
 
     ! Public interface
     interface regex
         module procedure re_match
+        module procedure re_match_nolength
         module procedure re_matchp
+        module procedure re_matchp_nolength
     end interface regex
 
     contains
@@ -123,12 +128,18 @@ end function nrules
 
     subroutine write_pattern(this,iunit)
         class(regex_op), intent(in) :: this
-        integer, intent(in) :: iunit
+        integer, optional, intent(in) :: iunit
+
+        integer :: i,u
 
-        integer :: i
+        if (present(iunit)) then
+            u = iunit
+        else
+            u = output_unit
+        end if
 
         do i=1,this%nrules()
-           write(iunit,'(a)') this%pattern(i)%print()
+           write(u,'(a)') this%pattern(i)%print()
         end do
 
     end subroutine write_pattern
@@ -243,11 +254,9 @@ logical function matchcharclass(c,str) result(match)
 
              if (matchmetachar(c,str(i:))) then
                 match = .true.
-                print *, 'match meta, c=',c
                 return
              elseif (c==str(i:i) .and. (.not.ismetachar(c))) then
                 match = .true.
-                print *, 'match not meta, c=',c
                 return
              endif
 
@@ -257,7 +266,6 @@ logical function matchcharclass(c,str) result(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)
-                print *, 'c is dash! match=',match
              else
                 match = .true.
              end if
@@ -266,7 +274,7 @@ logical function matchcharclass(c,str) result(match)
 
        end do loop
 
-       print *, 'charclass: no match on i=',i,' str=',trim(str),' c=',c
+       if (DEBUG) print *, 'charclass: no match on i=',i,' str=',trim(str),' c=',c
 
     end function matchcharclass
 
@@ -279,10 +287,8 @@ logical function matchquestion(p, pattern, text, matchlength)
 
        if (p%type == UNUSED) then
           matchquestion = .true.
-          print *, 'unused -> match'
           return
        elseif (matchpattern(pattern, text, matchlength)) then
-          print *, 'matchquestion 2: length=',matchlength,' match=.true.'
           matchquestion = .true.
           return
        elseif (len(text)>0) then
@@ -305,7 +311,7 @@ logical function matchstar(p, pattern, text, it0, matchlength)
 
        integer :: prelen,it
 
-       print *, 'match star, length=',matchlength,' it0=',it0,' lenm=',len(text)
+       if (DEBUG) print *, 'match star, length=',matchlength,' it0=',it0,' lenm=',len(text)
 
        if (len(text)<=0) then
           matchstar = .false.
@@ -343,7 +349,7 @@ logical function matchplus(p, pattern, text, it0, matchlength)
 
        integer :: it
 
-       print *, 'matchplus'
+       if (DEBUG) print *, 'matching PLUS pattern'
 
        it = it0
        do while (it>0 .and. it<=len(text))
@@ -375,9 +381,30 @@ integer function re_match(text, pattern, length) result(index)
 
     end function re_match
 
+    ! Find matches of the given pattern in the string
+    integer function re_match_nolength(text, pattern) result(index)
+       character(*,kind=RCK), intent(in) :: pattern
+       character(*,kind=RCK), intent(in) :: text
+
+       type (regex_op) :: command
+       integer :: length
+
+       command = parse_pattern(pattern)
+       index = re_matchp(text,command,length)
+
+    end function re_match_nolength
+
     type(regex_op) function parse_pattern(pattern) result(this)
        character(*,kind=RCK), intent(in) :: pattern
 
+       call new_from_pattern(this,pattern)
+
+    end function parse_pattern
+
+    subroutine new_from_pattern(this,pattern)
+       class(regex_op), intent(inout) :: this
+       character(*,kind=RCK), intent(in) :: 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
@@ -500,7 +527,7 @@ type(regex_op) function parse_pattern(pattern) result(this)
        ! Save number of patterns
        this%n = j-1
 
-    end function parse_pattern
+    end subroutine new_from_pattern
 
     function print_pattern(pattern) result(msg)
         class(regex_pattern), intent(in) :: pattern
@@ -541,9 +568,16 @@ logical function pat_match(p, c) result(match)
 
     end function pat_match
 
+    integer function re_matchp_nolength(text, pattern) result(index)
+       type(regex_op), intent(in) :: pattern
+       character(len=*,kind=RCK), intent(in) :: text
+       integer :: matchlength
+       index = re_matchp(text, pattern, matchlength)
+    end function re_matchp_nolength
+
 
     integer function re_matchp(text, pattern, matchlength) result(index)
-       type(regex_op) :: pattern
+       type(regex_op), intent(in) :: pattern
        character(len=*,kind=RCK), intent(in) :: text
        integer, intent(out) :: matchlength
 
@@ -555,24 +589,19 @@ integer function re_matchp(text, pattern, matchlength) result(index)
 
              ! String must begin with this pattern
              index = merge(1,0,matchpattern(pattern%pattern(2:), text, matchlength))
-             print *, 'begin with? index = ',index
 
           else
 
              do index=1,len(text)
                 if (matchpattern(pattern%pattern,text(index:),matchlength)) return
              end do
 
-             print *, 'all patterns not matched, ',text
-
              index = 0
 
           end if
 
        else
 
-          !print *, 'pattern has no patterns'
-
           index = 0
 
        end if
@@ -600,13 +629,9 @@ logical function matchpattern(pattern, text, matchlength) result(match)
 
       iterate: do while (ip<=size(pattern))
 
-         print *, 'trying pattern ',pattern(ip)%print(),' on character ',text(it:)
-
          if (pattern(ip)%type == UNUSED .or. pattern(ip+1)%type == QUESTIONMARK) then
 
-            print *, 'before matchquestion = ',match,' length=',matchlength
             match = matchquestion(pattern(ip),pattern(ip+2:),text(it:),matchlength)
-            print *, 'matchquestion = ',match,' length=',matchlength
             return
 
          elseif (pattern(ip+1)%type == STAR) then
@@ -621,7 +646,6 @@ logical function matchpattern(pattern, text, matchlength) result(match)
 
          elseif (pattern(ip)%type == END_WITH .and. pattern(ip+1)%type == UNUSED) then
 
-            print *, 'end pattern, len(text)',len(text(it:))
 
             match = len(text(it:))<=1
             return
@@ -631,7 +655,8 @@ logical function matchpattern(pattern, text, matchlength) result(match)
          matchlength = matchlength+1
 
          if (it>len(text)) exit iterate
-         print *, 'pat match with ip=',ip,' it=',it,' len=',len(text),' matchlenght=',matchlength
+
+         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
          it = it+1