Merge branch 'exp'

src/segment_m.F90

@@ -290,9 +290,12 @@ pure function symbol_to_segment(symbol) result(res)
       integer(int32) :: i, i_end, code
 
       ! If `symbol` is a empty character, return SEG_EMPTY
-      if (symbol == '') then
+      if (symbol == char(0)) then
          res = SEG_EMPTY
          return
+      else if (symbol == char(32)) then
+         res = SEG_SPACE
+         return
       end if
 
       ! Initialize indices
@@ -379,14 +382,41 @@ function segment_for_print (seg) result(res)
 
       if (seg == SEG_ANY) then
          res = "<ANY>"
+
+      else if (seg == SEG_TAB) then
+         res = "<TAB>"
+      else if (seg == segment_t(9, 10)) then
+         res = "<TAB, LF>"
+      else if (seg == segment_t(9, 11)) then
+         res = "<TAB, LF, VT>"   
+      else if (seg == segment_t(9, 12)) then
+         res = "<TAB, LF, VT, FF>"   
+      else if (seg == segment_t(9, 13)) then
+         res = "<TAB, LF, VT, FF, CR>"
+
       else if (seg == SEG_LF) then
          res = "<LF>"
-      else if (seg == SEG_CR) then
-         res = "<CR>"
+      else if (seg == segment_t(10, 11)) then
+         res = "<LF, VT>"   
+      else if (seg == segment_t(10, 12)) then
+         res = "<LF, VT, FF>"   
+      else if (seg == segment_t(10, 13)) then
+         res = "<LF, VT, FF, CR>"  
+
+      else if (seg == segment_t(11, 11)) then
+         res = "<VT>"   
+      else if (seg == segment_t(11, 12)) then
+         res = "<VT, FF>"   
+      else if (seg == segment_t(11, 13)) then
+         res = "<VT, FF, CR>"
+
       else if (seg == SEG_FF) then
          res = "<FF>"
-      else if (seg == SEG_TAB) then
-         res = "<TAB>"
+      else if (seg == segment_t(12, 13)) then
+         res = "<FF, CR>"
+
+      else if (seg == SEG_CR) then
+         res = "<CR>"
       else if (seg == SEG_SPACE) then
          res = "<SPACE>"
       else if (seg == SEG_ZENKAKU_SPACE) then
@@ -397,7 +427,6 @@ function segment_for_print (seg) result(res)
          res = "<INIT>"
       else if (seg == SEG_EMPTY) then
          res = "<EMPTY>"
-
       else if (seg%min == seg%max) then
          res = char_utf8(seg%min)
       else if (seg%max == UTF8_CODE_MAX) then

test/test_case_006.f90

@@ -0,0 +1,103 @@
+program test_006
+   use, intrinsic :: iso_fortran_env
+   use :: forgex_test_m
+   implicit none
+
+   logical :: res = .true.
+
+   ! Test case #6.
+   ! Tests for character classes of shorthand.
+
+   print *, "=== TEST CASE 6 BEGIN ==="
+
+   call runner_match("\s", ' ', .true., res)
+   call runner_match("\s", char(9), .true., res)
+   call runner_match("\s", char(10), .true., res)
+   call runner_match("\s", char(12), .true., res)
+   call runner_match("\s", char(13), .true., res)
+   call runner_match("\s", "　", .true., res)
+
+
+   call runner_match("\S", "!", .true., res)
+   call runner_match("\S", char(31), .true., res)
+   call runner_match("\S", " ", .false., res)
+   call runner_match("\S", "a", .true., res)
+   call runner_match("\S", "A", .true., res)
+   call runner_match("\S", "x", .true., res)
+   call runner_match("\S", "Z", .true., res)
+
+
+   call runner_match("\d{3}", "012", .true., res)
+   call runner_match("\d{3}", "234", .true., res)
+   call runner_match("\d{3}", "089", .true., res)
+   call runner_match("\d{3}", "/9:", .false., res)
+
+   call runner_match("\D", "a", .true., res)
+   call runner_match("\D", "/", .true., res)
+   call runner_match("\D", ":", .true., res)
+   call runner_match("\D", "A", .true., res)
+   call runner_match("\D", "0", .false., res)
+   call runner_match("\D", "1", .false., res)
+   call runner_match("\D", "2", .false., res)
+   call runner_match("\D", "3", .false., res)
+   call runner_match("\D", "4", .false., res)
+   call runner_match("\D", "5", .false., res)
+   call runner_match("\D", "6", .false., res)
+   call runner_match("\D", "7", .false., res)
+   call runner_match("\D", "8", .false., res)
+   call runner_match("\D", "9", .false., res)
+
+   call runner_match("\n", char(10), .true., res)  ! LF
+   call runner_match("\n", char(13)//char(10), .true., res) ! CRLF
+
+   call runner_match("\r", char(13), .true., res)  ! CR
+
+   call runner_match("\t", char(9), .true., res)
+
+   call runner_match("\w", "A", .true., res)
+   call runner_match("\w", "B", .true., res)
+   call runner_match("\w", "Z", .true., res)
+   call runner_match("\w", "a", .true., res)
+   call runner_match("\w", "b", .true., res)
+   call runner_match("\w", "z", .true., res)
+   call runner_match("\w", "_", .true., res)
+   call runner_match("\w", "0", .true., res)
+   call runner_match("\w", "9", .true., res)
+   call runner_match("\w", "/", .false., res)
+   call runner_match("\w", " ", .false., res)
+   call runner_match("\w", ":", .false., res)
+   call runner_match("\w", "@", .false., res)
+   call runner_match("\w", "[", .false., res)
+   call runner_match("\w", "`", .false., res)
+   call runner_match("\w", "{", .false., res)
+   call runner_match("\w", "^", .false., res)
+   call runner_match("\w", "`", .false., res)
+
+
+   call runner_match("\W", "A", .false., res)
+   call runner_match("\W", "B", .false., res)
+   call runner_match("\W", "Z", .false., res)
+   call runner_match("\W", "a", .false., res)
+   call runner_match("\W", "b", .false., res)
+   call runner_match("\W", "z", .false., res)
+   call runner_match("\W", "_", .false., res)
+   call runner_match("\W", "0", .false., res)
+   call runner_match("\W", "9", .false., res)
+   call runner_match("\W", "/", .true., res)
+   call runner_match("\W", " ", .true., res)
+   call runner_match("\W", ":", .true., res)
+   call runner_match("\W", "@", .true., res)
+   call runner_match("\W", "[", .true., res)
+   call runner_match("\W", "`", .true., res)
+   call runner_match("\W", "{", .true., res)
+
+
+   if (res) then
+      print *, "=== TEST CASE 6 END ==="
+      stop
+   else
+      error stop
+   end if
+
+
+end program test_006