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
|
program tw38429;
{$mode objfpc}{$h+}
uses
SysUtils, Variants, uw38429;
var
v, d: Variant;
I: Integer = 42;
begin
Writeln('Test VarAsType');
d := I;
try
v := VarAsType(d, varMyVar);
except
on e: exception do begin
WriteLn('cast ', VarTypeAsText(VarType(d)), ' to ',VarTypeAsText(varMyVar),
' raises ', e.ClassName, ' with message: ', e.Message);
Halt(1);
end;
end;
WriteLn('now v is ', VarTypeAsText(VarType(v)));
VarClear(d);
try
d := VarAsType(v, varInteger);
except
on e: exception do begin
WriteLn('cast ', VarTypeAsText(VarType(v)), ' to ',VarTypeAsText(varInteger),
' raises ', e.ClassName, ' with message: ', e.Message);
Halt(2);
end;
end;
WriteLn('now d is ', VarTypeAsText(VarType(d)));
{ also test VarCast from #20849 }
Writeln('Test VarCast');
d := I;
try
VarCast(v, d, varMyVar);
except
on e: exception do begin
WriteLn('cast ', VarTypeAsText(VarType(d)), ' to ',VarTypeAsText(varMyVar),
' raises ', e.ClassName, ' with message: ', e.Message);
Halt(3);
end;
end;
WriteLn('now v is ', VarTypeAsText(VarType(v)));
VarClear(d);
try
VarCast(d, v, varInteger);
except
on e: exception do begin
WriteLn('cast ', VarTypeAsText(VarType(v)), ' to ',VarTypeAsText(varInteger),
' raises ', e.ClassName, ' with message: ', e.Message);
Halt(4);
end;
end;
WriteLn('now d is ', VarTypeAsText(VarType(d)));
end.
|
