This is the multi-page printable view of this section. Click here to print.

Return to the regular view of this page.

Examples

Worked technical examples that show how the expertise pages are actually delivered in code — unit tests, SQL access, hash maps, the Promula preparser, and a REST API exposed from existing Fortran.

1 - Unit Tests

Unit Testing natively

TODO:

TODO

  • Unit test examples
  • TAP
  • Prove to run lots
  • Output from Prove with lots of tests

Example

! Local unit test

subroutine unit_main ()

! TEMPLATE Create any integers etc.
character(len=256) :: param1
character(len=256) :: charvar
integer diag_int
integer*4 diag_int4
double precision diag_double
INTEGER testint(32)

! TEMPLATE Plan some tests
call unit_plan(38)

call unit_starttime()

! TEMPLATE Example of how you can read a command line param
call unit_param(1, param1)
call unit_diag_string("param 1", param1)
! print *, param1

! Check too long - aka f90 vs ftn
call unit_diag_string("String Testing 123", "Here it is, a very long string that should still work because f90")
call unit_diag_string("String Testing + split",
+ "Here it is, a very long string that should still work because f90")
! TODO - should be supported, look at f90 config
!call unit_diag_string("String Testing & split" &
!      ,"Here it is, a very long string that should still work because f90")

! Testing integer strings
call mvwrd('test', testint, 2)
call unit_diag(testint)
call unit_diag_string("TestInt", testint)

! TEMPLATE Write your tests
call unit_diag("These tests should pass")
call unit_diag_string("String", "Here it is")
diag_int = 42
call unit_diag_integer("Integer", diag_int)
diag_int4 = 987654321
call unit_diag_integer4("Integer4", diag_int4)
! XXX Not working
! call unit_cmp_ok(diag_int, ">", 40, "Greater than 40")
diag_double = 54.321
call unit_diag_double("Double", diag_double)
! XXX Not working
! call unit_cmp_ok(diag_double, ">", 50, "Greater than 50")

! (leave this out) call unit_ok(1==0, "Should Fail")
call unit_ok(1, "First test")
call unit_is("fred", "fred", "Fred test was good")
call unit_cmp_ok(3, ">", 1, "Compare using >, <. ==, >= etc")
!call unit_cmp_ok(irc, "==", 7, "Compare using >, <. ==, >= etc")
!call unit_is_integer(irc, 7, "not found")

call unit_like("strange", "range", "strange ~~ /range/")
call unit_unlike("strange", "anger", "strange !~~ /anger/")
call unit_like("stranger", "^s.(r).*$", "matches the regex")

charvar = "ABC123"
call unit_diag_string("Variable", charvar)
call unit_ok(1, charvar)

call unit_ok(1, "OK 1")
integer testn
testn = 2
call unit_cmp_ok(testn, "==", 2, "OK int==2")

! Directory
call unit_dir_exists("/tmp", "Temp exists string")
charvar = "/tmp"
call unit_dir_exists(charvar, "Temp exists variable")
call unit_dir_notexists("/notexists", "Not exists string")

! File
call unit_file_exists("file.txt", "File exists")
call unit_file_notexists("/never.txt", "Not exists file")
call unit_file_notexists("/tmp", "Not exists file but is dir")

! File like
call unit_file_like("./file.txt", "z", 0, "File has no z")
call unit_file_like("./file.txt", "o", 3, "File has three o")
call unit_file_like("./file.txt", "th", 6, "File has five th")
call unit_file_like("./file.txt", ".i.th$", 2, "File has two .i.th")
call unit_file_like("./file.txt", ".i.th", 2, "File has two .i.th")
call unit_file_like("./file.txt", "Eight", 2, "two eight")
call unit_file_like("./file.txt", "^Eight", 1, "one eight start")
call unit_file_like("./file.txt", "^This.......$", 1, "one eight start")
call unit_file_like("./file.txt", "^This.{7}$", 1, "one eight start adv")
call unit_file_like("./file.txt", "^This.{6}$", 0, "one eight start adv")
call unit_file_like("./file.txt", "\d", 2, "2 digits")
call unit_file_like("./file.txt", "1[[:digit:]]{3}", 1, "1 digits")
call unit_file_like("./file.txt", "^.{82}$", 1, "1 82 char record")

! Check Sizes - size of character, array int and single int
call unit_size(charvar, 256, "Charvar is 256")
call unit_size(testint, 64, "Testint is 64")
call unit_size(diag_int, 2, "Single int is 2")

call unit_stoptime("Time?")

! Test double 
double precision expected_in, test_in
expected_in  = 0.6d0
test_in = 0.0d0
call unit_cmp_ok_double(test_in, "!=", expected_in, "Should not match")
expected_in  = 0.6d0
test_in  = 0.6000331d0
call unit_cmp_ok_double(test_in, "==", expected_in, "Should match")
call unit_cmp_ok_double(test_in, ">=", expected_in, "GT =")
call unit_cmp_ok_double(test_in, "<=", expected_in, "LT =")
expected_in  = 0.6d0
test_in  = 0.7d0
call unit_cmp_ok_double(test_in, ">", expected_in, "Should GT")
expected_in  = 0.8d0
test_in  = 0.7d0
call unit_cmp_ok_double(test_in, "<", expected_in, "Should LT")

if (unit_nodiag()) then
  print "(A)", "# NO DIAG ENABLED"
end if

if (.not. unit_nodiag()) then
  print "(A)", "# DIAG STILL ENABLED"
end if


! XXX Errors that hard to catch - C params
!call err$p('hello world~',,0,0,-1)

! Large like
call unit_like(
+ "abcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghij"
+ "abcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghij"
+ "abcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghij"
+ "abcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghij"
+ "abcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghij"
+ "abcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghijabcdefghij"
+ , "abc", "long string worked")

! TEMPLATE End
call unit_done_testing()

return

end subroutine unit_main

2 - SQL

SQL integration

TODO

subroutine test_select_simple ()
include lib_sql

call ptunit_planadd(1)
integer dbh
call sql_prepare(dbh,"SELECT * FROM test_full ORDER BY id DESC")
call sql_execute(dbh)
integer i = 0
do while (sql_fetch(dbh))
    i = i + 1
    print "(3x,i2,' id=', i4, ' description=', a12, ' cost=', i8, ' len=', i4)"
+      sql_row(dbh),
+      sql_get_integer(dbh, "id"), 
+      sql_get_string(dbh, "description"),
+      sql_get_integer(dbh, "cost"),
+      sql_get_length(dbh, "description")
    if (i == 4) then
        call ptunit_cmp_ok(sql_get_integer(dbh, "id"), "==", 5, "Saw that we selected id 5 last")
    end if
end do

call sql_info()
call sql_finish(dbh)

return

end subroutine test_select_simple

3 - Preparser

Add support for extra features like multiline strings

TODO

Multiline strings using """ triplequotes


  print *, """
        Hello World
        Another
  """
  
  call sql_prepare(dbh, """
    SELECT
            test_invoice.id,
            test_customer.company_name,
            sum(test_invoice_line.items * test_invoice_line.price) AS total,
            'AB12' as words
    FROM
            test_invoice,
            test_customer,
            test_invoice_line
    WHERE
            test_customer.id = test_invoice.test_customer_id
            AND test_invoice.id = test_invoice_line.test_invoice_id
    GROUP  BY
            test_invoice.id, test_customer.company_name
    ORDER BY
            test_customer.company_name
  """)

Supports embedded double quotes

  print *, """Hello "world" first"""

  print *, """
        Hello""" // "You" // """
        Again
  """

4 - API

Accessing any API. Writing your own APIs

TODO:

5 - Hash

Multi layer hash libraries

TODO:

Example

      integer found, hashcount
      integer keys1, keys2, keys3, keys4
      character(len=8) :: key1
      character(len=8) :: key2
      character(len=8) :: key3
      character(len=8) :: key4
      hashcount = pthash_count(big)
      found = 0
      keys1 = pthash_keys(big, "", "", "")
      do while ( pthash_keynext(keys1, key1) )
          keys2 = pthash_keys(big, key1, "", "")
          do while ( pthash_keynext(keys2, key2 ) )
              keys3 = pthash_keys(big, key1, key2, "")
              do while ( pthash_keynext(keys3, key3 ) )
                  keys4 = pthash_keys(big, key1, key2, key3)
                  do while ( pthash_keynext(keys4, key4 ) ) 
                      print *, key1, key2, key3, key4
                      found = found + 1
                  end do
                  call pthash_keyrelease(keys4)
              end do
              call pthash_keyrelease(keys3)
          end do
          call pthash_keyrelease(keys2)
      end do