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
|
{
Copyright 2007-2017 Michalis Kamburelis.
This file is part of "Castle Game Engine".
"Castle Game Engine" is free software; see the file COPYING.txt,
included in this distribution, for details about the copyright.
"Castle Game Engine" is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
----------------------------------------------------------------------------
}
{ Test some OS-specific utilities in castle_game_engine,
mostly in CastleFilesUtils unit.
Usually the mere purpose of these utilities is to hide some OS-specific
(UNIX-specific, Windows-specific) things from program. }
unit TestCastleFilesUtils;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry;
type
TTestOSSpecific = class(TTestCase)
published
procedure TestPathDelim;
procedure TestExeName;
procedure TestTimer;
{$ifdef UNIX} procedure TestHomePath; {$endif}
procedure TestGetTempDir;
end;
implementation
uses CastleUtils, CastleFindFiles, CastleFilesUtils, CastleTimeUtils
{$ifdef UNIX}, BaseUnix {$endif};
procedure TTestOSSpecific.TestPathDelim;
begin
{ slash should be added / stripped on both Windows and Unix }
AssertEquals('/tmp', ExclPathDelim('/tmp/'));
AssertEquals('', ExclPathDelim('/'));
AssertEquals('/tmp', ExclPathDelim('/tmp'));
AssertEquals('', ExclPathDelim(''));
AssertEquals('/tmp/', InclPathDelim('/tmp/'));
AssertEquals('/', InclPathDelim('/'));
AssertEquals('/tmp' + PathDelim, InclPathDelim('/tmp'));
AssertEquals(PathDelim, InclPathDelim(''));
{ backslash should be likewise added / stripped on Windows }
{$ifdef MSWINDOWS}
AssertEquals('\tmp', ExclPathDelim('\tmp\'));
AssertEquals('', ExclPathDelim('\'));
AssertEquals('\tmp', ExclPathDelim('\tmp'));
AssertEquals('', ExclPathDelim(''));
AssertEquals('\tmp\', InclPathDelim('\tmp\'));
AssertEquals('\', InclPathDelim('\'));
AssertEquals('\tmp\', InclPathDelim('\tmp'));
AssertEquals('\', InclPathDelim(''));
{$endif}
{ backslash should not be treated like dir separator on Unix }
{$ifdef UNIX}
AssertEquals('\tmp\', ExclPathDelim('\tmp\'));
AssertEquals('\', ExclPathDelim('\'));
AssertEquals('\tmp', ExclPathDelim('\tmp'));
AssertEquals('', ExclPathDelim(''));
AssertEquals('\tmp\/', InclPathDelim('\tmp\'));
AssertEquals('\/', InclPathDelim('\'));
AssertEquals('\tmp/', InclPathDelim('\tmp'));
AssertEquals('/', InclPathDelim(''));
{$endif}
end;
procedure TTestOSSpecific.TestExeName;
begin
try
{$push} // knowingly using deprecated below, for test
{$warnings off}
// Writeln('ExeName: '+ ExeName);
ExeName;
{$pop}
except
on E: EExeNameNotAvailable do
begin
// Writeln('ExeName not available, allowed on non-Windows:' +nl+ ExceptMessage(E));
{ This is an error under Windows, where ExeName is guaranteed to be available }
{$ifdef MSWINDOWS} raise; {$endif}
end;
end;
end;
procedure TTestOSSpecific.TestTimer;
{var
TimerStart: TTimerResult;}
begin
{ Writeln('Waiting 5 seconds...');
ProcessTimerBegin;
TimerStart := Timer;
Sleep(5000);
Writeln( Format(
'Sleep(5 seconds) done,' +nl+
'ProcessTimer reports that %f seconds elapsed,'+nl+
'Timer reports that %f seconds elapsed.',
[ ProcessTimerEnd, TimerSeconds(Timer, TimerStart) ])); }
end;
{$ifdef UNIX}
procedure TTestOSSpecific.TestHomePath;
begin
{ Writeln('HomePath is ', HomePath);
Writeln(' ~/expanded is ', ExpandHomePath('~/expanded')); }
AssertTrue(ExpandHomePath('/bin/') = '/bin/');
AssertTrue(ExpandHomePath('~') = ExclPathDelim(HomePath));
AssertTrue(ExpandHomePath('~/') = InclPathDelim(HomePath));
end;
{$endif}
procedure TTestOSSpecific.TestGetTempDir;
begin
// Writeln('TempDir: ', GetTempDir);
GetTempDir; // ignore result, just make sure it doesn't raise errors
end;
initialization
RegisterTest(TTestOSSpecific);
end.
|
