src/HOL/TPTP/TPTP_Test.thy
author sultana
Tue, 17 Apr 2012 16:14:07 +0100
changeset 47518 b2f209258621
parent 47512 b381d428a725
child 47547 1a5dc8377b5c
permissions -rw-r--r--
more cleaning of tptp tests;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
47512
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
     1
(*  Title:      HOL/TPTP/TPTP_Test.thy
47518
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
     2
    Author:     Nik Sultana, Cambridge University Computer Laboratory
47512
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
     3
47518
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
     4
Some test support for the TPTP interface. Some of the tests rely on
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
     5
the Isabelle environment variable TPTP_PROBLEMS_PATH, which should
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
     6
point to the TPTP-vX.Y.Z/Problems directory.
47512
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
     7
*)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
     8
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
     9
theory TPTP_Test
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    10
imports TPTP_Parser
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    11
begin
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    12
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    13
ML {*
47518
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
    14
  val tptp_test_out = Attrib.setup_config_string @{binding "tptp_test_out"} (K "")
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
    15
  val tptp_test_all = Attrib.setup_config_bool @{binding "tptp_test_all"} (K false)
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
    16
  val tptp_test_timeout =
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
    17
    Attrib.setup_config_int @{binding "tptp_test_timeout"} (K 5)
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
    18
  fun test_all ctxt = Config.get ctxt tptp_test_all
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
    19
  fun get_timeout ctxt = Config.get ctxt tptp_test_timeout
47512
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    20
  fun S x y z = x z (y z)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    21
*}
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    22
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    23
section "Parser tests"
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    24
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    25
ML {*
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    26
  fun payload_of (TPTP_Syntax.Annotated_Formula (_, _, _, _, fmla, _)) = fmla
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    27
  val payloads_of = map payload_of
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    28
*}
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    29
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    30
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    31
section "Source problems"
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    32
ML {*
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    33
  (*problem source*)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    34
  val tptp_probs_dir =
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    35
    Path.explode "$TPTP_PROBLEMS_PATH"
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    36
    |> Path.expand;
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    37
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    38
  (*list of files to under test*)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    39
  val files = TPTP_Syntax.get_file_list tptp_probs_dir;
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    40
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    41
(*  (*test problem-name parsing and mangling*)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    42
  val problem_names =
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    43
    map (Path.base #>
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    44
         Path.implode #>
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    45
         TPTP_Problem_Name.parse_problem_name #>
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    46
         TPTP_Problem_Name.mangle_problem_name)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    47
        files*)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    48
*}
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    49
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    50
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    51
section "Supporting test functions"
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    52
ML {*
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    53
  fun report ctxt str =
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    54
    let
47518
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
    55
      val tptp_test_out = Config.get ctxt tptp_test_out
47512
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    56
    in
47518
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
    57
      if tptp_test_out = "" then warning str
47512
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    58
      else
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    59
        let
47518
b2f209258621 more cleaning of tptp tests;
sultana
parents: 47512
diff changeset
    60
          val out_stream = TextIO.openAppend tptp_test_out
47512
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    61
        in (TextIO.output (out_stream, str ^ "\n");
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    62
            TextIO.flushOut out_stream;
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    63
            TextIO.closeOut out_stream)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    64
        end
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    65
    end
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    66
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    67
  fun test_fn ctxt f msg default_val file_name =
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    68
    let
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    69
      val _ = TPTP_Syntax.debug tracing (msg ^ " " ^ Path.print file_name)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    70
    in
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    71
     (f file_name; ())
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    72
     (*otherwise report exceptions as warnings*)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    73
     handle exn =>
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    74
       if Exn.is_interrupt exn then
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    75
         reraise exn
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    76
       else
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    77
         (report ctxt (msg ^ " test: file " ^ Path.print file_name ^
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    78
          " raised exception: " ^ ML_Compiler.exn_message exn);
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    79
          default_val)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    80
    end
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    81
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    82
  fun timed_test ctxt f =
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    83
    let
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    84
      fun f' x = (f x; ())
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    85
      val time =
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    86
        Timing.timing (List.app f') files
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    87
        |> fst
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    88
      val duration =
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    89
        #elapsed time
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    90
        |> Time.toSeconds
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    91
        |> Real.fromLargeInt
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    92
      val average =
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    93
        (StringCvt.FIX (SOME 3),
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    94
         (duration / Real.fromInt (length files)))
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    95
        |-> Real.fmt
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    96
    in
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    97
      report ctxt ("Test timing: " ^ Timing.message time ^ "\n(about " ^ average ^
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    98
       "s per problem)")
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
    99
    end
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   100
*}
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   101
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   102
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   103
ML {*
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   104
  fun situate file_name = Path.append tptp_probs_dir (Path.explode file_name);
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   105
  fun parser_test ctxt = (*FIXME argument order*)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   106
    test_fn ctxt
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   107
     (fn file_name =>
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   108
        Path.implode file_name
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   109
        |> (fn file =>
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   110
             ((*report ctxt file; this is if you want the filename in the log*)
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   111
              TPTP_Parser.parse_file file)))
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   112
     "parser"
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   113
     ()
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   114
*}
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   115
b381d428a725 reorganised tptp testing thys
sultana
parents:
diff changeset
   116
end