port completed; bugfixing in progress...

Author: perazz

project/fortran-regex.depend

@@ -5,3 +5,9 @@
 
 1662208326 source:/Users/federico/code/fortran-regex/test/testdata.f90
 
+1671094483 source:i:\fortran-regex\test\testdata.f90
+
+1671094429 source:i:\fortran-regex\src\regex.f90
+
+1671094129 source:i:\fortran-regex\test\test_1.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="0" zoom_2="0">
+	<File name="..\src\regex.f90" open="1" top="0" tabpos="2" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
 		<Cursor>
-			<Cursor1 position="13567" topLine="509" />
+			<Cursor1 position="17593" topLine="28" />
 		</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\testdata.f90" open="1" top="0" tabpos="3" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
 		<Cursor>
-			<Cursor1 position="199" topLine="5" />
+			<Cursor1 position="6700" topLine="86" />
 		</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\test_1.f90" open="1" top="1" tabpos="1" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
 		<Cursor>
-			<Cursor1 position="202" topLine="35" />
+			<Cursor1 position="359" topLine="0" />
 		</Cursor>
 	</File>
 </CodeBlocks_layout_file>

project/regex.mod

@@ -15,13 +15,13 @@
 !     http://www.cs.princeton.edu/courses/archive/spr09/cos333/beautiful.html
 !
 ! *************************************************************************************************
-module regex
+module regex_module
     implicit none
     private
 
     public :: parse_pattern
     !public :: re_matchp
-    !public :: re_match
+    public :: regex
 
     ! Character kind
     integer, parameter, public :: RCK = selected_char_kind("ascii")
@@ -88,14 +88,20 @@ module regex
 
         contains
 
-           procedure :: parse => parse_pattern
+           !procedure :: parse => parse_pattern
            procedure :: write => write_pattern
            procedure :: nrules
            procedure :: destroy
            final :: finalize
 
     end type regex_op
 
+    ! Public interface
+    interface regex
+        module procedure re_match
+        module procedure re_matchp
+    end interface regex
+
     contains
 
     ! Clean up a pattern
@@ -252,19 +258,91 @@ elemental logical function matchcharclass(c,str)
 
     end function matchcharclass
 
+    logical function matchquestion(p, pattern, text, matchlength)
+       type(regex_pattern), intent(in) :: p, pattern(:)
+       character(len=*,kind=RCK), intent(in) :: text
+       integer, intent(inout) :: matchlength
+
+       matchquestion = .false.
+
+       if (p%type == UNUSED .or. matchpattern(pattern, text, matchlength)) then
+          matchquestion = .true.
+          return
+       elseif (len(text)>0 .and. pat_match(p,text(2:))) then
+          if (matchpattern(pattern,text(2:),matchlength)) then
+             matchlength = matchlength+1
+             matchquestion = .true.
+             return
+          end if
+       end if
+
+    end function matchquestion
+
+    logical function matchstar(p, pattern, text, matchlength)
+       type(regex_pattern), intent(in) :: p, pattern(:)
+       character(len=*,kind=RCK), intent(in) :: text
+       integer, intent(inout) :: matchlength
+
+       integer :: prelen,it
+
+       ! Save input variables
+       prelen   = matchlength
+       it = 1
+
+       do while (it<=len(text) .and. pat_match(p, text(it:)))
+          it          = it+1
+          matchlength = matchlength+1
+       end do
+
+       do while (it>=1)
+         matchstar = matchpattern(pattern, text(it:), matchlength)
+         if (matchstar) return
+
+         it          = it-1
+         matchlength = matchlength-1
+
+       end do
+
+       matchlength = prelen
+       matchstar   = .false.
+
+    end function matchstar
+
+    logical function matchplus(p, pattern, text, matchlength)
+       type(regex_pattern), intent(in) :: p, pattern(:)
+       character(len=*,kind=RCK), intent(in) :: text
+       integer, intent(inout) :: matchlength
+
+       integer :: it
+
+       it = 1
+       do while (it<=len(text) .and. pat_match(p, text(it:)))
+          it = it+1
+          matchlength = matchlength+1
+       end do
+
+       do while (it>1)
+          matchplus = matchpattern(pattern, text(it:), matchlength)
+          if (matchplus) return
+          it = it-1
+          matchlength = matchlength-1
+       end do
+
+       matchplus = .false.
+
+    end function matchplus
+
     ! Find matches of the given pattern in the string
-    integer function re_match(pattern, text, length)
+    integer function re_match(pattern, text, length) result(index)
        character(*,kind=RCK), intent(in) :: pattern
        character(*,kind=RCK), intent(in) :: text
        integer, intent(out) :: length
 
-       !re_match = re_matchp(parse_pattern(pattern),text,length)
-       stop 're_match not impl'
+       index = re_matchp(parse_pattern(pattern),text,length)
 
     end function re_match
 
-    subroutine parse_pattern(this, pattern)
-       class(regex_op), intent(inout) :: this
+    type(regex_op) function parse_pattern(pattern) result(this)
        character(*,kind=RCK), intent(in) :: pattern
 
        ! Local variables
@@ -381,7 +459,7 @@ subroutine parse_pattern(this, pattern)
        ! Save number of patterns
        this%n = j-1
 
-    end subroutine parse_pattern
+    end function parse_pattern
 
     function print_pattern(pattern) result(msg)
         class(regex_pattern), intent(in) :: pattern
@@ -434,19 +512,24 @@ integer function re_matchp(pattern, text, 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,matchlength)) return
+                if (matchpattern(pattern%pattern,text(index:),matchlength)) return
              end do
 
+             !print *, 'all patterns not matched'
+
              index = 0
 
           end if
 
        else
 
+          !print *, 'pattern has no patterns'
+
           index = 0
 
        end if
@@ -456,124 +539,62 @@ end function re_matchp
 
 
 
-!
-!static int matchstar(regex_pattern p, regex_pattern* pattern, const char* text, int* matchlength)
-!{
-!  int prelen = *matchlength;
-!  const char* prepoint = text;
-!  while ((text[0] != '\0') && pat_match(p, *text))
-!  {
-!    text++;
-!    (*matchlength)++;
-!  }
-!  while (text >= prepoint)
-!  {
-!    if (matchpattern(pattern, text--, matchlength))
-!      return 1;
-!    (*matchlength)--;
-!  }
-!
-!  *matchlength = prelen;
-!  return 0;
-!}
-!
-!static int matchplus(regex_pattern p, regex_pattern* pattern, const char* text, int* matchlength)
-!{
-!  const char* prepoint = text;
-!  while ((text[0] != '\0') && pat_match(p, *text))
-!  {
-!    text++;
-!    (*matchlength)++;
-!  }
-!  while (text > prepoint)
-!  {
-!    if (matchpattern(pattern, text--, matchlength))
-!      return 1;
-!    (*matchlength)--;
-!  }
-!
-!  return 0;
-!}
-!
-!static int matchquestion(regex_pattern p, regex_pattern* pattern, const char* text, int* matchlength)
-!{
-!  if (p.type == UNUSED)
-!    return 1;
-!  if (matchpattern(pattern, text, matchlength))
-!      return 1;
-!  if (*text && pat_match(p, *text++))
-!  {
-!    if (matchpattern(pattern, text, matchlength))
-!    {
-!      (*matchlength)++;
-!      return 1;
-!    }
-!  }
-!  return 0;
-!}
-!
-!
+
+
+
 
    ! Iterative matching
    logical function matchpattern(pattern, text, matchlength) result(match)
       class(regex_pattern), intent(in) :: pattern(:)
       character(kind=RCK,len=*), intent(in) :: text
-      integer, intent(in) :: matchlength
+      integer, intent(inout) :: matchlength
 
-      integer :: pre
+      integer :: pre,ip,it
 
       pre = matchlength
+      ip  = 1
+      it  = 1
+
+      iterate: do while (ip<=size(pattern))
+
+         if (pattern(ip)%type == UNUSED .or. pattern(ip+1)%type == QUESTIONMARK) then
+
+            match = matchquestion(pattern(ip),pattern(ip+2:),text(it:),matchlength)
+            return
+
+         elseif (pattern(ip+1)%type == STAR) then
+
+            match = matchstar(pattern(ip),pattern(ip+2:), text(it:), matchlength)
+            return
+
+         elseif (pattern(ip+1)%type == PLUS) then
+
+            match = matchplus(pattern(ip),pattern(ip+2:), text(it:), matchlength)
+            return
+
+         elseif (pattern(ip)%type == END_WITH .and. pattern(ip+1)%type == UNUSED) then
+
+            match = len(text(it:))<=0
+            return
+
+         end if
+
+         matchlength = matchlength+1
+
+         ip = ip+1
+         it = it+1
+         if (it>len(text)) exit iterate
+         if (.not. pat_match(pattern(ip), text(it:it))) exit iterate
+
+      end do iterate
+
+      matchlength = pre
+      match = .false.
+      return
 
-!
-!      iterate: do
-!
-!
-!  do
-!  {
-!    if ((pattern[0].type == UNUSED) || (pattern[1].type == QUESTIONMARK))
-!    {
-!      return matchquestion(pattern[0], &pattern[2], text, matchlength);
-!    }
-!    else if (pattern[1].type == STAR)
-!    {
-!      return matchstar(pattern[0], &pattern[2], text, matchlength);
-!    }
-!    else if (pattern[1].type == PLUS)
-!    {
-!      return matchplus(pattern[0], &pattern[2], text, matchlength);
-!    }
-!    else if ((pattern[0].type == END) && pattern[1].type == UNUSED)
-!    {
-!      return (text[0] == '\0');
-!    }
-!/*  Branching is not working properly
-!    else if (pattern[1].type == BRANCH)
-!    {
-!      return (matchpattern(pattern, text) || matchpattern(&pattern[2], text));
-!    }
-!*/
-!  (*matchlength)++;
-!  }
-!  while ((text[0] != '\0') && pat_match(*pattern++, *text++));
-!
-!   *matchlength = pre;
-!
-!   ierr = 0
-!
-!   end function matchpattern
-!
-!static int matchpattern(regex_pattern* pattern, const char* text, int* matchlength)
-!{
-!  int pre = *matchlength;
-!
-!}
-!
-!#endif
-!
-!
    end function matchpattern
 
 
 
 
-end module regex
+end module regex_module