Tests moved to 'interactive'

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@10257 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
author: Xavier Clerc <xavier.clerc@inria.fr> 2010-04-08 12:48:54 +0000
committer: Xavier Clerc <xavier.clerc@inria.fr> 2010-04-08 12:48:54 +0000
commit: 1cc7dffb2d97ce8a34dff983eb30c29fa1314e32 (patch)
tree: 24b1dba3b00e4bb61ae7d9b48dde6e998ffe5c2a /testsuite/interactive
parent: f3fc27c47c1aefa2fe847cae531d8eddaf9576a4 (diff)
14 files changed, 1315 insertions, 0 deletions
diff --git a/testsuite/interactive/lib-gc/Makefile b/testsuite/interactive/lib-gc/Makefile
new file mode 100644
index 000000000..4eb07e7e9
--- /dev/null
+++ b/testsuite/interactive/lib-gc/Makefile
@@ -0,0 +1,10 @@
+default:
+	@$(OCAMLC) -o program.byte alloc.ml
+	@./program.byte
+	@$(OCAMLOPT) -o program.native alloc.ml
+	@./program.native
+
+clean: defaultclean
+	@rm -fr program.*
+
+include ../../makefiles/Makefile.common
diff --git a/testsuite/interactive/lib-gc/alloc.ml b/testsuite/interactive/lib-gc/alloc.ml
new file mode 100644
index 000000000..4f607fb23
--- /dev/null
+++ b/testsuite/interactive/lib-gc/alloc.ml
@@ -0,0 +1,51 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id: alloc.ml 2553 1999-11-17 18:59:06Z xleroy $ *)
+
+(* Random allocation test *)
+
+(*
+  Allocate arrays of strings, of random sizes in [0..1000[, and put them
+  into an array of 32768.  Replace a randomly-selected array with a new
+  random-length array.  Reiterate ad infinitum.
+*)
+
+let l = 32768;;
+let m = 1000;;
+
+let ar = Array.create l "";;
+
+Random.init 1234;;
+
+let compact_flag = ref false;;
+
+let main () =
+  while true do
+    for i = 1 to 100000 do
+      ar.(Random.int l) <- String.create (Random.int m);
+    done;
+    if !compact_flag then Gc.compact () else Gc.full_major ();
+    print_newline ();
+    Gc.print_stat stdout;
+    flush stdout;
+  done
+;;
+
+let argspecs = [
+  "-c", Arg.Set compact_flag, "do heap compactions";
+];;
+
+Arg.parse argspecs (fun _ -> ()) "Usage: alloc [-c]";;
+
+main ();;
+
diff --git a/testsuite/interactive/lib-gc/alloc.result b/testsuite/interactive/lib-gc/alloc.result
new file mode 100644
index 000000000..9503b34c6
--- /dev/null
+++ b/testsuite/interactive/lib-gc/alloc.result
@@ -0,0 +1,544 @@
+
+minor_words: 6410964
+promoted_words: 6332175
+major_words: 6393661
+minor_collections: 196
+major_collections: 14
+heap_words: 3936256
+heap_chunks: 31
+top_heap_words: 3936256
+live_words: 2034808
+live_blocks: 31786
+free_words: 1901339
+free_blocks: 16531
+largest_free: 1357
+fragments: 109
+compactions: 0
+
+minor_words: 12805330
+promoted_words: 12664909
+major_words: 12739763
+minor_collections: 391
+major_collections: 21
+heap_words: 4571136
+heap_chunks: 36
+top_heap_words: 4571136
+live_words: 2126718
+live_blocks: 33282
+free_words: 2444325
+free_blocks: 19124
+largest_free: 1824
+fragments: 93
+compactions: 0
+
+minor_words: 19215544
+promoted_words: 18998176
+major_words: 19100845
+minor_collections: 586
+major_collections: 28
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2135891
+live_blocks: 33344
+free_words: 2562126
+free_blocks: 19238
+largest_free: 1405
+fragments: 95
+compactions: 0
+
+minor_words: 25638028
+promoted_words: 25361252
+major_words: 25472205
+minor_collections: 782
+major_collections: 35
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2137378
+live_blocks: 33350
+free_words: 2560637
+free_blocks: 19112
+largest_free: 1634
+fragments: 97
+compactions: 0
+
+minor_words: 32062298
+promoted_words: 31721945
+major_words: 31842628
+minor_collections: 978
+major_collections: 41
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2145462
+live_blocks: 33351
+free_words: 2552521
+free_blocks: 19013
+largest_free: 1999
+fragments: 129
+compactions: 0
+
+minor_words: 38449694
+promoted_words: 38049841
+major_words: 38176354
+minor_collections: 1173
+major_collections: 48
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2125014
+live_blocks: 33351
+free_words: 2572992
+free_blocks: 19080
+largest_free: 1525
+fragments: 106
+compactions: 0
+
+minor_words: 44846324
+promoted_words: 44379560
+major_words: 44521194
+minor_collections: 1368
+major_collections: 55
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2136556
+live_blocks: 33351
+free_words: 2561444
+free_blocks: 19191
+largest_free: 1760
+fragments: 112
+compactions: 0
+
+minor_words: 51240537
+promoted_words: 50707711
+major_words: 50862160
+minor_collections: 1563
+major_collections: 61
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2136623
+live_blocks: 33351
+free_words: 2561383
+free_blocks: 18967
+largest_free: 1526
+fragments: 106
+compactions: 0
+
+minor_words: 57628061
+promoted_words: 57038039
+major_words: 57197286
+minor_collections: 1758
+major_collections: 68
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2133895
+live_blocks: 33351
+free_words: 2564119
+free_blocks: 19273
+largest_free: 1793
+fragments: 98
+compactions: 0
+
+minor_words: 64028127
+promoted_words: 63367620
+major_words: 63545093
+minor_collections: 1953
+major_collections: 74
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2138085
+live_blocks: 33351
+free_words: 2559920
+free_blocks: 19111
+largest_free: 1800
+fragments: 107
+compactions: 0
+
+minor_words: 70438812
+promoted_words: 69698963
+major_words: 69904882
+minor_collections: 2148
+major_collections: 80
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2131008
+live_blocks: 33351
+free_words: 2566995
+free_blocks: 19079
+largest_free: 1451
+fragments: 109
+compactions: 0
+
+minor_words: 76852923
+promoted_words: 76032234
+major_words: 76270123
+minor_collections: 2343
+major_collections: 86
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2135699
+live_blocks: 33351
+free_words: 2562313
+free_blocks: 19201
+largest_free: 2056
+fragments: 100
+compactions: 0
+
+minor_words: 83248665
+promoted_words: 82362663
+major_words: 82613979
+minor_collections: 2538
+major_collections: 92
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2126387
+live_blocks: 33351
+free_words: 2571625
+free_blocks: 19099
+largest_free: 1498
+fragments: 100
+compactions: 0
+
+minor_words: 89636938
+promoted_words: 88694885
+major_words: 88952817
+minor_collections: 2733
+major_collections: 99
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2136754
+live_blocks: 33351
+free_words: 2561246
+free_blocks: 19220
+largest_free: 1697
+fragments: 112
+compactions: 0
+
+minor_words: 96030388
+promoted_words: 95026453
+major_words: 95296004
+minor_collections: 2928
+major_collections: 106
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2126039
+live_blocks: 33351
+free_words: 2571956
+free_blocks: 19250
+largest_free: 1593
+fragments: 117
+compactions: 0
+
+minor_words: 102436652
+promoted_words: 101356198
+major_words: 101649957
+minor_collections: 3123
+major_collections: 113
+heap_words: 4698112
+heap_chunks: 37
+top_heap_words: 4698112
+live_words: 2140261
+live_blocks: 33351
+free_words: 2557747
+free_blocks: 19192
+largest_free: 1731
+fragments: 104
+compactions: 0
+
+minor_words: 108832359
+promoted_words: 107686065
+major_words: 107994506
+minor_collections: 3318
+major_collections: 119
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2124817
+live_blocks: 33351
+free_words: 2700160
+free_blocks: 19149
+largest_free: 1617
+fragments: 111
+compactions: 0
+
+minor_words: 115220373
+promoted_words: 114018413
+major_words: 114333086
+minor_collections: 3513
+major_collections: 125
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2124190
+live_blocks: 33351
+free_words: 2700795
+free_blocks: 19303
+largest_free: 1567
+fragments: 103
+compactions: 0
+
+minor_words: 121628396
+promoted_words: 120347328
+major_words: 120688494
+minor_collections: 3708
+major_collections: 131
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2133563
+live_blocks: 33351
+free_words: 2691408
+free_blocks: 19134
+largest_free: 2129
+fragments: 117
+compactions: 0
+
+minor_words: 128038304
+promoted_words: 126675491
+major_words: 127045570
+minor_collections: 3903
+major_collections: 137
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2135379
+live_blocks: 33351
+free_words: 2689601
+free_blocks: 19345
+largest_free: 1699
+fragments: 108
+compactions: 0
+
+minor_words: 134429672
+promoted_words: 133007487
+major_words: 133387404
+minor_collections: 4098
+major_collections: 143
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2127333
+live_blocks: 33351
+free_words: 2697647
+free_blocks: 19276
+largest_free: 1758
+fragments: 108
+compactions: 0
+
+minor_words: 140831438
+promoted_words: 139333508
+major_words: 139733383
+minor_collections: 4293
+major_collections: 149
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2145113
+live_blocks: 33351
+free_words: 2679876
+free_blocks: 19365
+largest_free: 1650
+fragments: 99
+compactions: 0
+
+minor_words: 147229656
+promoted_words: 145661743
+major_words: 146077858
+minor_collections: 4488
+major_collections: 155
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2132556
+live_blocks: 33351
+free_words: 2692441
+free_blocks: 19150
+largest_free: 1431
+fragments: 91
+compactions: 0
+
+minor_words: 153646155
+promoted_words: 152024536
+major_words: 152442636
+minor_collections: 4684
+major_collections: 161
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2130394
+live_blocks: 33351
+free_words: 2694592
+free_blocks: 19164
+largest_free: 1288
+fragments: 102
+compactions: 0
+
+minor_words: 160038986
+promoted_words: 158352855
+major_words: 158781961
+minor_collections: 4879
+major_collections: 167
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2131838
+live_blocks: 33351
+free_words: 2693140
+free_blocks: 19355
+largest_free: 1741
+fragments: 110
+compactions: 0
+
+minor_words: 166458940
+promoted_words: 164714552
+major_words: 165149249
+minor_collections: 5075
+major_collections: 173
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2146731
+live_blocks: 33351
+free_words: 2678258
+free_blocks: 19338
+largest_free: 1951
+fragments: 99
+compactions: 0
+
+minor_words: 172869183
+promoted_words: 171044208
+major_words: 171507681
+minor_collections: 5270
+major_collections: 179
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2130620
+live_blocks: 33351
+free_words: 2694346
+free_blocks: 19355
+largest_free: 1716
+fragments: 122
+compactions: 0
+
+minor_words: 179276123
+promoted_words: 177371439
+major_words: 177859651
+minor_collections: 5465
+major_collections: 185
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2141174
+live_blocks: 33351
+free_words: 2683827
+free_blocks: 19340
+largest_free: 1707
+fragments: 87
+compactions: 0
+
+minor_words: 185681086
+promoted_words: 183702557
+major_words: 184213391
+minor_collections: 5660
+major_collections: 191
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2133699
+live_blocks: 33351
+free_words: 2691284
+free_blocks: 19303
+largest_free: 1557
+fragments: 105
+compactions: 0
+
+minor_words: 192087937
+promoted_words: 190033229
+major_words: 190568763
+minor_collections: 5855
+major_collections: 197
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2133162
+live_blocks: 33351
+free_words: 2691831
+free_blocks: 19299
+largest_free: 1561
+fragments: 95
+compactions: 0
+
+minor_words: 198496824
+promoted_words: 196364203
+major_words: 196926470
+minor_collections: 6050
+major_collections: 203
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2129841
+live_blocks: 33351
+free_words: 2695139
+free_blocks: 19163
+largest_free: 1653
+fragments: 108
+compactions: 0
+
+minor_words: 204889797
+promoted_words: 202693452
+major_words: 203267275
+minor_collections: 6245
+major_collections: 209
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2130715
+live_blocks: 33351
+free_words: 2694271
+free_blocks: 19257
+largest_free: 1491
+fragments: 102
+compactions: 0
+
+minor_words: 211268811
+promoted_words: 208990042
+major_words: 209593734
+minor_collections: 6439
+major_collections: 215
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2128683
+live_blocks: 33351
+free_words: 2696320
+free_blocks: 19306
+largest_free: 1789
+fragments: 85
+compactions: 0
+
+minor_words: 217673548
+promoted_words: 215319820
+major_words: 215946607
+minor_collections: 6634
+major_collections: 221
+heap_words: 4825088
+heap_chunks: 38
+top_heap_words: 4825088
+live_words: 2134523
+live_blocks: 33351
+free_words: 2690457
+free_blocks: 19391
+largest_free: 1845
+fragments: 108
+compactions: 0
diff --git a/testsuite/interactive/lib-graph-2/Makefile b/testsuite/interactive/lib-graph-2/Makefile
new file mode 100644
index 000000000..354953bfc
--- /dev/null
+++ b/testsuite/interactive/lib-graph-2/Makefile
@@ -0,0 +1,7 @@
+MODULES=
+MAIN_MODULE=graph_test
+ADD_COMPFLAGS=
+LIBRARIES=graphics
+
+include ../../makefiles/Makefile.one
+include ../../makefiles/Makefile.common
diff --git a/testsuite/interactive/lib-graph-2/graph_test.ml b/testsuite/interactive/lib-graph-2/graph_test.ml
new file mode 100644
index 000000000..217e2fa56
--- /dev/null
+++ b/testsuite/interactive/lib-graph-2/graph_test.ml
@@ -0,0 +1,288 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
+(*                                                                     *)
+(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  the special exception on linking described in file ../../LICENSE.  *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* graph_test.ml : tests various drawing and filling primitives of the
+   Graphics library. *)
+
+(* To run this example just load this file into a suitable toplevel.
+   Alternatively execute
+   ocamlc graphics.cma graph_test.ml *)
+
+open Graphics;;
+
+auto_synchronize false;;
+display_mode false;;
+remember_mode true;;
+
+let sz = 450;;
+
+open_graph (Printf.sprintf " %ix%i" sz sz);;
+
+(* To be defined for older versions of O'Caml
+   Lineto, moveto and draw_rect.
+
+let rlineto x y =
+ let xc, yc = current_point () in
+ lineto (x + xc) (y + yc);;
+
+let rmoveto x y =
+ let xc, yc = current_point () in
+ moveto (x + xc) (y + yc);;
+
+let draw_rect x y w h =
+ let x0, y0 = current_point () in
+ moveto x y;
+ rlineto w 0;
+ rlineto 0 h;
+ rlineto (- w) 0;
+ rlineto 0 (-h);
+ moveto x0 y0;;
+*)
+
+(* A set of points. *)
+
+set_color foreground;;
+
+let dashes y =
+ for i = 1 to 100 do
+  plot y (2 * i);
+  plot y (3 * i);
+  plot y (4 * i);
+ done;;
+
+dashes 3;;
+
+set_line_width 20;;
+dashes (sz - 20);;
+
+(* Drawing chars *)
+
+draw_char 'C';
+draw_char 'a';
+draw_char 'm';
+draw_char 'l';;
+
+(* More and more red enlarging squares *)
+moveto 10 10;;
+set_line_width 5;;
+
+let carre c =
+ rlineto 0 c;
+ rlineto c 0;
+ rlineto 0 (- c);
+ rlineto (- c) 0;;
+
+for i = 1 to 10 do
+ moveto (10 * i) (10 * i);
+ set_color (rgb (155 + 10 * i) 0 0);
+ carre (10 * i)
+done;;
+
+(* Blue squares in arithmetic progression *)
+moveto 10 210;;
+set_color blue;;
+set_line_width 1;;
+
+for i = 1 to 10 do
+ carre (10 * i)
+done;;
+
+(* Tiny circles filled or not *)
+rmoveto 0 120;;
+(* Must not change the current point *)
+fill_circle 20 190 10;;
+set_color green;;
+rlineto 0 10;;
+rmoveto 50 10;;
+let x, y = current_point () in
+(* Must not change the current point *)
+draw_circle x y 20;;
+set_color black;;
+rlineto 0 20;;
+
+(* Cyan rectangles as a kind of graphical representation *)
+set_color cyan;;
+
+let lw = 15;;
+set_line_width lw;;
+let go_caption l = moveto 210 (130 - lw + l);;
+let go_legend () = go_caption (- 3 * lw);;
+
+go_caption 0;;
+fill_rect 210 130 5 10;;
+fill_rect 220 130 10 20;;
+fill_rect 235 130 15 40;;
+fill_rect 255 130 20 80;;
+fill_rect 280 130 25 160;;
+(* A green rectangle below the graph. *)
+set_color green;;
+rlineto 50 0;;
+
+(* A black frame for each of our rectangles *)
+set_color black;;
+set_line_width (lw / 4);;
+
+draw_rect 210 130 5 10;;
+draw_rect 220 130 10 20;;
+draw_rect 235 130 15 40;;
+draw_rect 255 130 20 80;;
+draw_rect 280 130 25 160;;
+
+(* A black rectangle after the green one, below the graph. *)
+set_line_width lw;;
+rlineto 50 0;;
+
+(* Write a text in yellow on a blue background. *)
+(* x = 210, y = 70 *)
+go_legend ();;
+set_text_size 10;;
+set_color (rgb 150 100 250);;
+let x,y = current_point () in
+fill_rect x (y - 5) (8 * 20) 25;;
+set_color yellow;;
+go_legend ();;
+draw_string "Graphics (Caml)";;
+
+(* Pie parts in different colors. *)
+let draw_green_string s = set_color green; draw_string s;;
+let draw_red_string s = set_color red; draw_string s;;
+
+moveto 120 210;;
+set_color red;;
+fill_arc 150 260 25 25 60 300;
+draw_green_string "A ";
+draw_red_string "red";
+draw_green_string " pie.";
+
+set_text_size 5;
+moveto 180 240;
+draw_red_string "A "; draw_green_string "green"; draw_red_string " slice.";;
+set_color green;
+fill_arc 200 260 25 25 0 60;
+set_color black;
+set_line_width 2;
+draw_arc 200 260 27 27 0 60;;
+
+(* Should do nothing since this is a line *)
+set_color red;;
+fill_poly [| (40, 10); (150, 70); (150, 10); (40, 10) |];;
+set_color blue;;
+
+(* Drawing polygones. *)
+(* Redefining the draw_poly primitive for the usual library. *)
+let draw_poly v =
+ let l = Array.length v in
+  if l > 0 then begin
+  let x0, y0 = current_point () in
+  let p0 = v.(0) in
+  let x, y = p0 in moveto x y;
+  for i = 1 to l - 1 do
+   let x, y = v.(i) in lineto x y
+  done;
+  lineto x y;
+  moveto x0 y0
+ end;;
+
+draw_poly [| (150, 10); (150, 70); (260, 10); (150, 10) |];;
+
+(* Filling polygones. *)
+(* Two equilateral triangles, one red and one blue, and their inside
+   filled in black. *)
+let equi x y l =
+ [| (x - l / 2, y);
+    (x, y + int_of_float (float_of_int l *. (sqrt 3.0 /. 2.0)));
+    (x + l / 2, y) |];;
+
+set_color black;;
+fill_poly (Array.append (equi 300 20 40) (equi 300 44 (- 40)));;
+
+set_line_width 1;;
+set_color cyan;;
+draw_poly (equi 300 20 40);;
+set_color red;;
+draw_poly (equi 300 44 (- 40));;
+
+(* Drawing and filling ellipses. *)
+let x, y = current_point () in
+rlineto 10 10; moveto x y;
+
+moveto 395 100;;
+
+let x, y = current_point () in
+fill_ellipse x y 25 15;;
+
+set_color (rgb 0xFF 0x00 0xFF);;
+rmoveto 0 (- 50);;
+
+let x, y = current_point () in
+fill_ellipse x y 15 30;;
+
+rmoveto (- 45) 0;;
+let x, y = current_point () in
+draw_ellipse x y 25 10;;
+
+(* Drawing and filling arcs. *)
+
+let draw_arc_ellipse x y r1 r2 =
+  set_color green;
+  draw_arc x y r1 r2 60 120;
+  set_color black;
+  draw_arc x y r1 r2 120 420;;
+
+set_line_width 3;;
+
+let draw_arc_ellipses x y r1 r2 =
+  let step = 5 in
+  for i = 0 to (r1 - step) / (2 * step) do
+   for j = 0 to (r2 - step) / (2 * step) do
+    draw_arc_ellipse x y (3 * i * step) (3 * j * step)
+   done
+  done;;
+
+draw_arc_ellipses 20 128 15 50;;
+
+let fill_arc_ellipse x y r1 r2 c1 c2 =
+  set_color c1;
+  fill_arc x y r1 r2 60 120;
+  set_color c2;
+  fill_arc x y r1 r2 120 420;;
+
+let fill_arc_ellipses x y r1 r2 =
+  let step = 3 in
+  let c1 = ref black
+  and c2 = ref yellow in
+  let exchange r1 r2 = let tmp = !r1 in r1 := !r2; r2 := tmp in
+  for i = r1 / (2 * step) downto 10 do
+   for j = r2 / (2 * step) downto 30 do
+    exchange c1 c2;
+    fill_arc_ellipse x y (3 * i) (3 * j) !c1 !c2
+   done
+  done;;
+
+fill_arc_ellipses 400 240 150 200;;
+
+
+synchronize ();;
+
+(* transparent color drawing *)
+set_color transp;;
+draw_circle 400 240 50;;
+draw_circle 400 240 40;;
+draw_circle 400 240 30;;
+(* try to go back a normal color *)
+set_color red;;
+draw_circle 400 240 20;;
+
+synchronize ();;
+
+ignore (wait_next_event [Key_pressed])
diff --git a/testsuite/interactive/lib-graph-2/graph_test.reference b/testsuite/interactive/lib-graph-2/graph_test.reference
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/testsuite/interactive/lib-graph-2/graph_test.reference
diff --git a/testsuite/interactive/lib-graph-3/Makefile b/testsuite/interactive/lib-graph-3/Makefile
new file mode 100644
index 000000000..295f47895
--- /dev/null
+++ b/testsuite/interactive/lib-graph-3/Makefile
@@ -0,0 +1,7 @@
+MODULES=
+MAIN_MODULE=sorts
+ADD_COMPFLAGS=-thread
+LIBRARIES=unix threads graphics
+
+include ../../makefiles/Makefile.one
+include ../../makefiles/Makefile.common
diff --git a/testsuite/interactive/lib-graph-3/sorts.ml b/testsuite/interactive/lib-graph-3/sorts.ml
new file mode 100644
index 000000000..abc8dc1b5
--- /dev/null
+++ b/testsuite/interactive/lib-graph-3/sorts.ml
@@ -0,0 +1,228 @@
+(* Animation of sorting algorithms. *)
+
+open Graphics
+
+(* Information on a given sorting process *)
+
+type graphic_context =
+  { array: int array;                   (* Data to sort *)
+    x0: int;                            (* X coordinate, lower left corner *)
+    y0: int;                            (* Y coordinate, lower left corner *)
+    width: int;                         (* Width in pixels *)
+    height: int;                        (* Height in pixels *)
+    nelts: int;                         (* Number of elements in the array *)
+    maxval: int;                        (* Max val in the array + 1 *)
+    rad: int                            (* Dimension of the rectangles *)
+  }
+
+(* Array assignment and exchange with screen update *)
+
+let screen_mutex = Mutex.create()
+
+let draw gc i v =
+  fill_rect (gc.x0 + (gc.width * i) / gc.nelts)
+            (gc.y0 + (gc.height * v) / gc.maxval)
+            gc.rad gc.rad
+
+let assign gc i v =
+  Mutex.lock screen_mutex;
+  set_color background; draw gc i gc.array.(i);
+  set_color foreground; draw gc i v;
+  gc.array.(i) <- v;
+  Mutex.unlock screen_mutex
+
+let exchange gc i j =
+  let val_i = gc.array.(i) in
+  assign gc i gc.array.(j);
+  assign gc j val_i
+
+(* Construction of a graphic context *)
+
+let initialize name array maxval x y w h =
+  let (_, label_height) = text_size name in
+  let rad = (w - 2) / (Array.length array) - 1 in
+  let gc =
+    { array = Array.copy array;
+      x0 = x + 1;                       (* Leave one pixel left for Y axis *)
+      y0 = y + 1;                       (* Leave one pixel below for X axis *)
+      width = w - 2;                    (* 1 pixel left, 1 pixel right *)
+      height = h - 1 - label_height - rad;
+      nelts = Array.length array;
+      maxval = maxval;
+      rad = rad } in
+  moveto (gc.x0 - 1) (gc.y0 + gc.height);
+  lineto (gc.x0 - 1) (gc.y0 - 1);
+  lineto (gc.x0 + gc.width) (gc.y0 - 1);
+  moveto (gc.x0 - 1) (gc.y0 + gc.height);
+  draw_string name;
+  for i = 0 to Array.length array - 1 do
+    draw gc i array.(i)
+  done;
+  gc
+
+(* Main animation function *)
+
+let display functs nelts maxval =
+  let a = Array.create nelts 0 in
+  for i = 0 to nelts - 1 do
+    a.(i) <- Random.int maxval
+  done;
+  let num_finished = ref 0 in
+  let lock_finished = Mutex.create() in
+  let cond_finished = Condition.create() in
+  for i = 0 to Array.length functs - 1 do
+    let (name, funct, x, y, w, h) = functs.(i) in
+    let gc = initialize name a maxval x y w h in
+    Thread.create
+      (fun () ->
+        funct gc;
+        Mutex.lock lock_finished;
+        incr num_finished;
+        Mutex.unlock lock_finished;
+        Condition.signal cond_finished)
+      ()
+  done;
+  Mutex.lock lock_finished;
+  while !num_finished < Array.length functs do
+    Condition.wait cond_finished lock_finished
+  done;
+  Mutex.unlock lock_finished;
+  read_key()
+
+(*****
+  let delay = ref 0 in
+  try
+    while true do
+      let gc = Queue.take q in
+        begin match gc.action with
+          Finished -> ()
+        | Pause f ->
+            gc.action <- f ();
+            for i = 0 to !delay do () done;
+            Queue.add gc q
+        end;
+      if key_pressed() then begin
+        match read_key() with
+          'q'|'Q' ->
+            raise Exit
+        | '0'..'9' as c ->
+            delay := (Char.code c - 48) * 500
+        | _ ->
+            ()
+      end
+    done
+  with Exit -> ()
+     | Queue.Empty -> read_key(); ()
+*****)
+
+(* The sorting functions. *)
+
+(* Bubble sort *)
+
+let bubble_sort gc =
+  let ordered = ref false in
+  while not !ordered do
+    ordered := true;
+    for i = 0 to Array.length gc.array - 2 do
+      if gc.array.(i+1) < gc.array.(i) then begin
+        exchange gc i (i+1);
+        ordered := false
+      end
+    done
+  done
+
+(* Insertion sort *)
+
+let insertion_sort gc =
+  for i = 1 to Array.length gc.array - 1 do
+    let val_i = gc.array.(i) in
+    let j = ref (i - 1) in
+    while !j >= 0 && val_i < gc.array.(!j) do
+      assign gc (!j + 1) gc.array.(!j);
+      decr j
+    done;
+    assign gc (!j + 1) val_i
+  done
+
+(* Selection sort *)
+
+let selection_sort gc =
+  for i = 0 to Array.length gc.array - 1 do
+    let min = ref i in
+    for j = i+1 to Array.length gc.array - 1 do
+      if gc.array.(j) < gc.array.(!min) then min := j
+    done;
+    exchange gc i !min
+  done
+
+(* Quick sort *)
+
+let quick_sort gc =
+  let rec quick lo hi =
+    if lo < hi then begin
+      let i = ref lo in
+      let j = ref hi in
+      let pivot = gc.array.(hi) in
+      while !i < !j do
+        while !i < hi && gc.array.(!i) <= pivot do incr i done;
+        while !j > lo && gc.array.(!j) >= pivot do decr j done;
+        if !i < !j then exchange gc !i !j
+      done;
+      exchange gc !i hi;
+      quick lo (!i-1);
+      quick (!i+1) hi
+    end
+  in quick 0 (Array.length gc.array - 1)
+
+(* Merge sort *)
+
+let merge_sort gc =
+  let rec merge i l1 l2 =
+    match (l1, l2) with
+      ([], []) ->
+        ()
+    | ([], v2::r2) ->
+        assign gc i v2; merge (i+1) l1 r2
+    | (v1::r1, []) ->
+        assign gc i v1; merge (i+1) r1 l2
+    | (v1::r1, v2::r2) ->
+        if v1 < v2
+        then begin assign gc i v1; merge (i+1) r1 l2 end
+        else begin assign gc i v2; merge (i+1) l1 r2 end in
+  let rec msort start len =
+    if len < 2 then () else begin
+      let m = len / 2 in
+      msort start m;
+      msort (start+m) (len-m);
+      merge start
+            (Array.to_list (Array.sub gc.array start m))
+            (Array.to_list (Array.sub gc.array (start+m) (len-m)))
+    end in
+  msort 0 (Array.length gc.array)
+
+(* Main program *)
+
+let animate() =
+  open_graph "";
+  moveto 0 0; draw_string "Press a key to start...";
+  let seed = ref 0 in
+  while not (key_pressed()) do incr seed done;
+  read_key();
+  Random.init !seed;
+  clear_graph();
+  let prompt = "0: fastest ... 9: slowest, press 'q' to quit" in
+  moveto 0 0; draw_string prompt;
+  let (_, h) = text_size prompt in
+  let sx = size_x() / 2 and sy = (size_y() - h) / 3 in
+  display [| "Bubble", bubble_sort, 0, h, sx, sy;
+             "Insertion", insertion_sort, 0, h+sy, sx, sy;
+             "Selection", selection_sort, 0, h+2*sy, sx, sy;
+             "Quicksort", quick_sort, sx, h, sx, sy;
+             (** "Heapsort", heap_sort, sx, h+sy, sx, sy; **)
+             "Mergesort", merge_sort, sx, h+2*sy, sx, sy |]
+          100 1000;
+  close_graph()
+
+let _ = if !Sys.interactive then () else begin animate(); exit 0 end
+
+;;
diff --git a/testsuite/interactive/lib-graph-3/sorts.reference b/testsuite/interactive/lib-graph-3/sorts.reference
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/testsuite/interactive/lib-graph-3/sorts.reference
diff --git a/testsuite/interactive/lib-graph/Makefile b/testsuite/interactive/lib-graph/Makefile
new file mode 100644
index 000000000..de2c9e865
--- /dev/null
+++ b/testsuite/interactive/lib-graph/Makefile
@@ -0,0 +1,7 @@
+MODULES=
+MAIN_MODULE=graph_example
+ADD_COMPFLAGS=
+LIBRARIES=graphics
+
+include ../../makefiles/Makefile.one
+include ../../makefiles/Makefile.common
diff --git a/testsuite/interactive/lib-graph/graph_example.ml b/testsuite/interactive/lib-graph/graph_example.ml
new file mode 100644
index 000000000..6fbe988ce
--- /dev/null
+++ b/testsuite/interactive/lib-graph/graph_example.ml
@@ -0,0 +1,131 @@
+(* To run this example:
+   ********************
+   1. Select all the text in this window.
+   2. Drag it to the toplevel window.
+   3. Watch the colors.
+   4. Drag the mouse over the graphics window and click here and there.
+   5. Type any key to the graphics window to stop the program.
+*)
+
+open Graphics;;
+open_graph " 480x270";;
+
+let xr = size_x () / 2 - 30
+and yr = size_y () / 2 - 26
+and xg = size_x () / 2 + 30
+and yg = size_y () / 2 - 26
+and xb = size_x () / 2
+and yb = size_y () / 2 + 26
+;;
+
+let point x y =
+  let dr = (x-xr)*(x-xr) + (y-yr)*(y-yr)
+  and dg = (x-xg)*(x-xg) + (y-yg)*(y-yg)
+  and db = (x-xb)*(x-xb) + (y-yb)*(y-yb)
+  in
+  if dr > dg && dr > db then set_color (rgb 255 (255*dg/dr) (255*db/dr))
+  else if dg > db then set_color (rgb (255*dr/dg) 255 (255*db/dg))
+  else set_color (rgb (255*dr/db) (255*dg/db) 255);
+  fill_rect x y 2 2;
+;;
+
+for y = (size_y () - 1) / 2 downto 0 do
+  for x = 0 to (size_x () - 1) / 2 do
+    point (2*x) (2*y);
+  done
+done
+;;
+
+let n = 0x000000
+and w = 0xFFFFFF
+and b = 0xFFCC99
+and y = 0xFFFF00
+and o = 0xCC9966
+and v = 0x00BB00
+and g = 0x888888
+and c = 0xDDDDDD
+and t = transp
+;;
+
+let caml = make_image [|
+  [|t;t;t;t;t;t;t;t;t;t;t;n;n;n;n;n;n;t;t;t;t;t;t;t;t;t;t;t;t;t;t;t;|];
+  [|t;t;t;t;t;t;t;t;t;t;n;n;n;n;n;n;n;n;n;t;t;t;t;t;t;t;t;t;t;t;t;t;|];
+  [|t;t;t;t;t;t;t;t;n;n;n;n;n;n;n;n;n;n;n;n;t;t;t;t;t;t;t;t;t;t;t;t;|];
+  [|n;n;n;n;n;n;t;n;n;n;n;n;b;b;b;b;b;b;b;n;n;t;t;t;t;t;n;n;n;n;n;t;|];
+  [|n;o;o;o;o;o;n;n;n;n;b;b;b;b;b;b;b;b;b;b;b;n;n;n;n;n;n;n;n;n;n;t;|];
+  [|n;o;o;o;o;o;o;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;t;|];
+  [|n;o;o;o;o;o;o;o;n;n;n;g;g;g;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;t;t;|];
+  [|n;n;o;o;o;o;o;o;o;n;n;n;c;c;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;t;t;|];
+  [|t;n;n;o;o;o;o;o;o;o;n;n;n;c;n;n;n;n;n;n;n;b;b;n;n;n;n;n;n;t;t;t;|];
+  [|t;t;n;n;n;o;o;o;o;o;o;n;n;n;n;n;n;n;n;n;b;b;b;b;n;n;n;n;t;t;t;t;|];
+  [|t;t;t;t;n;n;o;o;o;o;o;o;n;n;n;n;n;n;n;n;b;b;b;b;b;b;n;n;t;t;t;t;|];
+  [|t;t;t;t;t;n;n;o;o;o;o;o;o;n;n;n;n;n;n;o;o;b;b;b;b;b;b;n;n;t;t;t;|];
+  [|t;t;t;t;t;n;n;o;o;o;o;o;o;b;b;b;b;b;n;n;o;o;b;b;b;b;b;b;n;n;t;t;|];
+  [|t;t;t;t;n;n;n;o;o;o;o;o;b;b;b;b;b;b;b;n;n;o;o;b;b;b;b;b;b;n;n;t;|];
+  [|t;t;t;t;n;n;n;o;o;o;o;b;b;b;b;b;b;b;b;b;n;n;o;o;b;b;b;b;b;b;n;n;|];
+  [|t;t;t;t;n;n;n;o;o;o;o;b;b;b;b;b;n;n;b;b;b;n;n;o;o;b;b;b;b;b;n;n;|];
+  [|t;t;t;t;n;n;n;o;o;o;o;b;b;b;b;b;n;n;b;b;b;b;n;n;o;o;b;o;b;b;n;n;|];
+  [|t;t;t;t;n;n;n;o;o;o;o;b;b;b;b;b;n;n;b;b;b;b;b;n;n;o;o;o;o;o;n;n;|];
+  [|t;t;t;t;n;n;n;o;o;o;o;b;b;b;b;b;n;n;b;b;b;b;b;b;n;n;o;o;o;o;n;n;|];
+  [|t;t;t;t;n;n;n;o;o;o;o;o;b;b;b;b;n;n;b;b;b;b;b;b;b;n;n;o;o;n;n;n;|];
+  [|t;t;t;t;n;n;n;n;o;o;o;o;o;b;b;b;n;n;n;b;b;b;b;b;b;b;n;n;o;n;b;n;|];
+  [|t;t;t;t;t;n;n;n;o;o;o;o;o;o;b;b;n;n;n;b;b;b;b;b;b;b;b;n;n;n;b;n;|];
+  [|t;t;t;t;t;t;n;n;o;o;o;o;o;o;o;y;v;y;n;b;b;b;b;b;b;b;b;n;n;b;b;n;|];
+  [|t;t;t;t;t;t;t;n;o;o;o;o;o;v;y;o;o;n;n;n;b;b;b;b;b;b;b;n;n;b;b;n;|];
+  [|t;t;t;t;t;t;t;n;o;o;o;y;v;o;o;o;o;n;n;n;n;b;b;b;b;b;b;n;n;b;b;n;|];
+  [|t;t;t;t;t;t;n;n;o;v;y;o;y;o;o;o;o;o;o;n;n;n;b;b;b;b;b;n;n;b;b;n;|];
+  [|t;t;t;t;t;t;n;o;y;y;o;o;v;o;o;o;o;o;o;o;n;n;n;b;b;b;n;n;n;b;n;t;|];
+  [|t;t;t;t;t;n;n;v;o;v;o;o;o;o;o;o;o;o;o;o;o;n;n;n;b;n;n;n;n;b;n;t;|];
+  [|t;t;t;t;t;n;v;o;o;v;o;o;o;o;o;o;o;o;o;o;o;o;n;n;n;n;n;n;n;n;t;t;|];
+  [|t;t;t;t;n;n;o;o;o;o;o;o;o;o;o;o;o;o;o;o;o;n;n;n;n;n;n;t;t;t;t;t;|];
+  [|t;t;t;t;n;o;o;o;o;o;o;o;o;o;o;o;o;o;o;o;n;n;t;t;t;t;t;t;t;t;t;t;|];
+  [|t;t;t;t;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;n;t;t;t;t;t;t;t;t;t;t;t;|];
+|];;
+
+(*
+let x = ref 0 and y = ref 0;;
+let bg = get_image !x !y 32 32;;
+while true do
+  let st = wait_next_event [Mouse_motion; Button_down] in
+  if not st.button then draw_image bg !x !y;
+  x := st.mouse_x;
+  y := st.mouse_y;
+  blit_image bg !x !y;
+  draw_image caml !x !y;
+done;;
+*)
+set_color (rgb 0 0 0);
+remember_mode false;
+try while true do
+  let st = wait_next_event [Mouse_motion; Button_down; Key_pressed] in
+  synchronize ();
+  if st.keypressed then raise Exit;
+  if st.button then begin
+    remember_mode true;
+    draw_image caml st.mouse_x st.mouse_y;
+    remember_mode false;
+  end;
+  let x = st.mouse_x + 16 and y = st.mouse_y + 16 in
+
+  moveto 0 y;
+  lineto (x - 25) y;
+  moveto 10000 y;
+  lineto (x + 25) y;
+
+  moveto x 0;
+  lineto x (y - 25);
+  moveto x 10000;
+  lineto x (y + 25);
+
+  draw_image caml st.mouse_x st.mouse_y;
+done with Exit -> ()
+;;
+
+(* To run this example:
+   ********************
+   1. Select all the text in this window.
+   2. Drag it to the toplevel window.
+   3. Watch the colors.
+   4. Drag the mouse over the graphics window and click here and there.
+   5. Type any key to the graphics window to stop the program.
+*)
diff --git a/testsuite/interactive/lib-graph/graph_example.reference b/testsuite/interactive/lib-graph/graph_example.reference
new file mode 100644
index 000000000..e69de29bb
--- /dev/null
+++ b/testsuite/interactive/lib-graph/graph_example.reference
diff --git a/testsuite/interactive/lib-signals/Makefile b/testsuite/interactive/lib-signals/Makefile
new file mode 100644
index 000000000..445f9ac70
--- /dev/null
+++ b/testsuite/interactive/lib-signals/Makefile
@@ -0,0 +1,10 @@
+default:
+	@$(OCAMLC) -o program.byte signals.ml
+	@./program.byte
+	@$(OCAMLOPT) -o program.native signals.ml
+	@./program.native
+
+clean: defaultclean
+	@rm -fr program.*
+
+include ../../makefiles/Makefile.common
diff --git a/testsuite/interactive/lib-signals/signals.ml b/testsuite/interactive/lib-signals/signals.ml
new file mode 100644
index 000000000..8a5c4e0c5
--- /dev/null
+++ b/testsuite/interactive/lib-signals/signals.ml
@@ -0,0 +1,32 @@
+let rec tak (x, y, z) =
+  if x > y then tak(tak (x-1, y, z), tak (y-1, z, x), tak (z-1, x, y))
+           else z
+
+let break_handler _ =
+  print_string "Thank you for pressing ctrl-C."; print_newline();
+  print_string "Allocating a bit..."; flush stdout;
+  ignore (tak(18,12,6)); print_string "done."; print_newline()
+
+let stop_handler _ =
+  print_string "Thank you for pressing ctrl-Z."; print_newline();
+  print_string "Now raising an exception..."; print_newline();
+  raise Exit
+
+let _ =
+  ignore (Sys.signal Sys.sigint (Sys.Signal_handle break_handler));
+  ignore (Sys.signal Sys.sigtstp (Sys.Signal_handle stop_handler));
+  begin try
+    print_string "Computing like crazy..."; print_newline();
+    for i = 1 to 1000 do ignore (tak(18,12,6)) done;
+    print_string "Reading on input..."; print_newline();
+    for i = 1 to 5 do
+      try
+        let s = read_line () in
+        print_string ">> "; print_string s; print_newline()
+      with Exit ->
+        print_string "Got Exit, continuing."; print_newline()
+    done
+  with Exit ->
+    print_string "Got Exit, exiting."; print_newline()
+  end;
+  exit 0
author	Xavier Clerc <xavier.clerc@inria.fr>	2010-04-08 12:48:54 +0000
committer	Xavier Clerc <xavier.clerc@inria.fr>	2010-04-08 12:48:54 +0000
commit	1cc7dffb2d97ce8a34dff983eb30c29fa1314e32 (patch)
tree	24b1dba3b00e4bb61ae7d9b48dde6e998ffe5c2a /testsuite/interactive
parent	f3fc27c47c1aefa2fe847cae531d8eddaf9576a4 (diff)