basis/tools/counting-profiler/counting-profiler-tests.factor

   1 USING: accessors tools.counting-profiler tools.test kernel memory math
   2 threads alien alien.c-types tools.counting-profiler.private sequences
   3 compiler.test compiler.units words arrays ;
   4 IN: tools.counting-profiler.tests
   5
   6 [ t ] [
   7     \ length counter>>
   8     10 [ { } length drop ] times
   9     \ length counter>> =
  10 ] unit-test
  11
  12 [ ] [ [ 3 [ gc ] times ] profile ] unit-test
  13
  14 [ ] [ [ 1000000 sleep ] profile ] unit-test
  15
  16 [ ] [ profile. ] unit-test
  17
  18 [ ] [ vocabs-profile. ] unit-test
  19
  20 [ ] [ "kernel.private" vocab-profile. ] unit-test
  21
  22 [ ] [ \ + usage-profile. ] unit-test
  23
  24 : callback-test ( -- callback ) void { } cdecl [ ] alien-callback ;
  25
  26 : indirect-test ( callback -- ) void { } cdecl alien-indirect ;
  27
  28 : foobar ( -- ) ;
  29
  30 [
  31     [ ] [ callback-test indirect-test ] unit-test
  32     foobar
  33 ] profile
  34
  35 [ 1 ] [ \ foobar counter>> ] unit-test
  36
  37 : fooblah ( -- ) { } [ ] like call( -- ) ;
  38
  39 : foobaz ( -- ) fooblah fooblah ;
  40
  41 [ foobaz ] profile
  42
  43 [ 1 ] [ \ foobaz counter>> ] unit-test
  44
  45 [ 2 ] [ \ fooblah counter>> ] unit-test
  46
  47 : recompile-while-profiling-test ( -- ) ;
  48
  49 [ ] [
  50     [
  51         333 [ recompile-while-profiling-test ] times
  52         { recompile-while-profiling-test } compile
  53         333 [ recompile-while-profiling-test ] times
  54     ] profile
  55 ] unit-test
  56
  57 [ 666 ] [ \ recompile-while-profiling-test counter>> ] unit-test
  58
  59 [ ] [ [ [ ] compile-call ] profile ] unit-test
  60
  61 [ [ gensym execute ] profile ] [ undefined? ] must-fail-with
  62
  63 : crash-bug-1 ( -- x ) "hi" <uninterned-word> ;
  64 : crash-bug-2 ( -- ) 100000 [ crash-bug-1 drop ] times ;
  65
  66 [ ] [ [ crash-bug-2 ] profile ] unit-test
  67
  68 [ 1 ] [
  69     [
  70         [ [ ] ( -- ) define-temp ] with-compilation-unit
  71         dup execute( -- )
  72     ] profile
  73     counter>>
  74 ] unit-test
  75
  76 ! unwind_native_frames() would fail if profiling was enabled
  77 ! because the jit-profiling stub would clobber a parameter register
  78 ! on x86-64
  79 [ [ -10 f <array> ] profile ] must-fail