1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
(* TEST
* hasunix
include unix
** native
*)
open Bigarray
(* Test harness *)
let error_occurred = ref false
let function_tested = ref ""
let testing_function s =
function_tested := s;
print_newline();
print_string s;
print_newline()
let test test_number answer correct_answer =
flush stdout;
flush stderr;
if answer <> correct_answer then begin
Printf.eprintf "*** Bad result (%s, test %d)\n" !function_tested test_number;
flush stderr;
error_occurred := true
end else begin
Printf.printf " %d..." test_number
end
(* Tests *)
let tests () =
let mapped_file = Filename.temp_file "bigarray" ".data" in
begin
testing_function "map_file";
let fd =
Unix.openfile mapped_file
[Unix.O_RDWR; Unix.O_TRUNC; Unix.O_CREAT] 0o666 in
let a =
array1_of_genarray (Unix.map_file fd float64 c_layout true [|10000|])
in
Unix.close fd;
for i = 0 to 9999 do a.{i} <- float i done;
let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
let b =
array2_of_genarray
(Unix.map_file fd float64 fortran_layout false [|100; -1|])
in
Unix.close fd;
let ok = ref true in
for i = 0 to 99 do
for j = 0 to 99 do
if b.{j+1,i+1} <> float (100 * i + j) then ok := false
done
done;
test 1 !ok true;
b.{50,50} <- (-1.0);
let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
let c =
array2_of_genarray (Unix.map_file fd float64 c_layout false [|-1; 100|])
in
Unix.close fd;
let ok = ref true in
for i = 0 to 99 do
for j = 0 to 99 do
if c.{i,j} <> float (100 * i + j) then ok := false
done
done;
test 2 !ok true;
let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
let c =
array2_of_genarray
(Unix.map_file fd ~pos:800L float64 c_layout false [|-1; 100|])
in
Unix.close fd;
let ok = ref true in
for i = 1 to 99 do
for j = 0 to 99 do
if c.{i-1,j} <> float (100 * i + j) then ok := false
done
done;
test 3 !ok true;
let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
let c =
array2_of_genarray
(Unix.map_file fd ~pos:79200L float64 c_layout false [|-1; 100|])
in
Unix.close fd;
let ok = ref true in
for j = 0 to 99 do
if c.{0,j} <> float (100 * 99 + j) then ok := false
done;
test 4 !ok true;
testing_function "map_file errors";
(* Insufficient permissions *)
let fd = Unix.openfile mapped_file [Unix.O_RDONLY] 0 in
test 1 true
begin try
ignore (Unix.map_file fd float64 c_layout true [|-1; 100|]); false
with
| Unix.Unix_error((Unix.EACCES | Unix.EPERM), _, _) -> true
| Unix.Unix_error(err, _, _) ->
Printf.eprintf "Unexpected error %s\n%!" (Unix.error_message err);
false
end;
Unix.close fd;
(* Invalid handle *)
test 2 true
begin try
ignore (Unix.map_file fd float64 c_layout true [|-1; 100|]); false
with
| Unix.Unix_error((Unix.EBADF|Unix.EINVAL), _, _) -> true
| Unix.Unix_error(err, _, _) ->
Printf.eprintf "Unexpected error %s\n%!" (Unix.error_message err);
false
end
end;
(* Force garbage collection of the mapped bigarrays above, otherwise
Win32 doesn't let us erase the file. Notice the begin...end above
so that the VM doesn't keep stack references to the mapped bigarrays. *)
Gc.full_major();
Sys.remove mapped_file;
()
[@@inline never]
(********* End of test *********)
let _ =
tests ();
print_newline();
if !error_occurred then begin
prerr_endline "************* TEST FAILED ****************"; exit 2
end else
exit 0
|
