regexec Function

public function regexec(this, string, matches, flags, status) result(match)

NAME

regexec(3f) - [M_regex] Execute a compiled regex against a string

SYNOPSIS

function regexec(this,string,matches,flags,status) result(match)

  logical :: match ! .TRUE. if the pattern matched
  type(regex_type),intent(in)           :: this
  character(len=*),intent(in)           :: string
  integer, intent(out),optional         :: matches(:,:)
  character(len=*),intent(in), optional :: flags
  integer, intent(out),optional         :: status

DESCRIPTION

OPTIONS

 THIS      regex object
 STRING    target string
 MATCHES   match locations dimension(2,*)
 FLAGS     flag characters for partial lines:

              o b = no beginning-of-line (REG_NOTBOL)
              o e = no end-of-line (REG_NOTEOL)
 STATUS    if absent, errors are fatal
           0      successfully found match
           1      successfully found no match
           other  regexec(3f) failed

RETURNS

regexec    LOGICAL value is .TRUE. if a match was found

EXAMPLE

Sample program

program demo_regexec
! read regular expression from command line and look for it in lines read from stdin.
use M_regex, only: regex_type, regcomp, regexec, regfree
implicit none
integer                      :: command_argument_length
character(len=:),allocatable :: command_argument
character(len=1024)          :: input_line
type(regex_type)             :: regex
logical                      :: match
integer                      :: ios
   call get_command_argument(number=1,length=command_argument_length)
   allocate(character(len=command_argument_length) :: command_argument)
   call get_command_argument(1, command_argument)
   call regcomp(regex,command_argument,'xn') ! compile up regular expression
   INFINITE: do
      read(*,'(a)',iostat=ios)input_line
      if(ios.ne.0)exit INFINITE
      match=regexec(regex,input_line) ! look for a match in (remaining) string
      if(.not.match)cycle INFINITE    ! if no match found go for next line
      write(*,'(a)') trim(input_line) ! show line with match
   enddo INFINITE
   call regfree(regex)                ! free memory used for compiled regular expression
end program demo_regexec

Sample Output

  demo_regexec '\<integer\>' < demo_regexec.f90
  integer                      :: command_argument_length
  integer                      :: ios

Arguments

Type IntentOptional Attributes Name
type(regex_type), intent(in) :: this
character(len=*), intent(in) :: string
integer, intent(out), optional :: matches(:,:)
character(len=*), intent(in), optional :: flags
integer, intent(out), optional :: status

Return Value logical


Source Code

logical function regexec(this,string,matches,flags,status) result(match)

! ident_2="@(#) M_exec regexec(3f) Execute a compiled RE(regular expression) against a string"

type(regex_type), intent(in)             :: this
character(len=*), intent(in)             :: string
character(len=*), intent(in), optional   :: flags
integer, intent(out), optional           :: matches(:,:)
integer, intent(out), optional           :: status
integer(C_int)                           :: status_, matches_(2,1)
character(len=10,kind=C_char)            :: flags_
integer                                  :: maxlen
character(kind=c_char,len=1),allocatable :: char_temp1(:)
character(kind=c_char,len=1),allocatable :: char_temp2(:)
interface
   subroutine C_regexec(preg,string,nmatch,matches,flags,status) bind(C,name="C_regexec")
     import
     type(C_ptr), intent(in), value           :: preg
     character(len=1,kind=C_char), intent(in) :: string(*)
     integer(C_int), intent(in), value        :: nmatch
     integer(C_int), intent(out)              :: matches(2,nmatch)
     character(len=1,kind=C_char), intent(in) :: flags(*)
     integer(C_int), intent(out)              :: status
   end subroutine C_regexec
end interface

   if(present(flags))then
      flags_=flags
   else
      flags_=' '
   endif

   status_=0
   maxlen=len(string)
   if(present(matches))then
      matches=0
      char_temp1 = s2c( trim(string) )
      char_temp2 = s2c( trim(flags_) )
      call C_regexec(this%preg, char_temp1, size(matches,dim=2),matches, char_temp2, status_)
      !write(*,'("<",a,*(sp,i0.4:,","))')'MATCHES(1,:)=',matches(1,:)
      !write(*,'("<",a,*(sp,i0.4:,","))')'MATCHES(2,:)=',matches(2,:)
      where(matches(1,:).ge.0)matches(1,:)=matches(1,:)+1
      where(matches.gt.maxlen)matches=-1
      !write(*,'(">",a,*(sp,i0.4:,","))')'MATCHES(1,:)=',matches(1,:)
      !write(*,'(">",a,*(sp,i0.4:,","))')'MATCHES(2,:)=',matches(2,:)
   else
      char_temp1 = s2c( trim(string) )
      char_temp2 = s2c( trim(flags_) )
      call C_regexec(this%preg, char_temp1, int(0,C_int), matches_, char_temp2, status_)
   endif

   match = status_==0

   if (present(status))then
      status=status_
   elseif(status_/=0.and.status_/=1)then
      stop 'Regex runtime error: regexec failed.'
   endif

end function regexec