← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to api/test/testfsys.pas

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
api/test/testfsys.pas
1
 
{ test application for FileSys
2
 
  make sure a file called testfile.txt (here in FName) exists;
3
 
  it will be deleted ! }
4
 
program TestFS;
5
 
 
6
 
uses
7
 
  ApiComm,
8
 
  Filesys;
9
 
 
10
 
const
11
 
  Passes = 12;
12
 
  FName  : string[30] = 'testfile.txt';
13
 
  DName  : string[30] = 'test';
14
 
  TestNames : array[0..Passes-1] of string[30] =
15
 
    ('CreateDir',
16
 
     'RenameDir',
17
 
     'ExpandName',
18
 
     'GetCurrentDir',
19
 
     'DeleteDir',
20
 
 
21
 
     'Check name',
22
 
     'Set time',
23
 
     'DateToString/TimeToString',
24
 
     'Set attribute',
25
 
     'FileAttrToString',
26
 
     'FileIntToString',
27
 
     'SplitName'
28
 
    );
29
 
 
30
 
var
31
 
  i           : byte;
32
 
  n, p, rn, e : TFileName;
33
 
  dt          : TDateTime;
34
 
  attr        : TFileAttr;
35
 
  fi          : TFileInt;
36
 
 
37
 
begin
38
 
  WriteLn ('TestFS - tests capabilities of unit FileSys');
39
 
  WriteLn ('---');
40
 
  i := 0;
41
 
  repeat
42
 
    { show topic }
43
 
    case i of
44
 
      0 : WriteLn ('<DIRECTORY>');
45
 
      5 : WriteLn ('<FILE>');
46
 
    end;
47
 
    { show name of action }
48
 
    Write (TestNames[i], ' ');
49
 
    { perform action }
50
 
    case i of
51
 
      0 :
52
 
        begin
53
 
          Write ('"', DName, '"');
54
 
          FileSys.CreateDir (DName);
55
 
        end;
56
 
      1 :
57
 
        begin
58
 
          Write (DName, '=> test2');
59
 
          RenameDir (DName, 'test2');
60
 
          GetErrorCode;
61
 
          RenameDir ('test2', DName);
62
 
        end;
63
 
      2 :
64
 
        begin
65
 
          Write ('"', ExpandName (DName),'"');
66
 
        end;
67
 
      3 :
68
 
        begin
69
 
          Write ('"', GetCurrentDir, '"');
70
 
        end;
71
 
      4 :
72
 
        begin
73
 
          Write ('"', DName, '"');
74
 
          FileSys.DeleteDir (DName);
75
 
        end;
76
 
      { FILE }
77
 
      5 :
78
 
        begin
79
 
          Write ('"', FName, '" : ');
80
 
          if (FileSys.CheckName (FName) = cnUnknown)
81
 
            then Write ('unknown')
82
 
            else Write ('known');
83
 
        end;
84
 
      6 :
85
 
        begin
86
 
          Write (' 22 Jul 1997 12:34:56');
87
 
          with dt do begin
88
 
            Day :=    22;
89
 
            Month :=  7;
90
 
            Year :=   1997;
91
 
            Hour :=   12;
92
 
            Minute := 34;
93
 
            Second := 56;
94
 
            CheckDateTime (dt);
95
 
          end;
96
 
          SetFTime (FName, dt);
97
 
        end;
98
 
      7 :
99
 
        begin
100
 
          Write (DateToString (dt), ' ', TimeToString (dt));
101
 
        end;
102
 
      8 :
103
 
        begin
104
 
          attr := 128;
105
 
          SetFAttr (FName, attr);
106
 
        end;
107
 
      9 :
108
 
        begin
109
 
          Write (FileAttrToString (attr));
110
 
        end;
111
 
     10 :
112
 
        begin
113
 
          fi := 12345678;
114
 
          Write (FileIntToString (fi));
115
 
        end;
116
 
     11 :
117
 
        begin
118
 
          {$ifdef linux}
119
 
          n := '/sub1/sub3.ext.ext/name.gz';
120
 
          {$ELSE}
121
 
          n := 'c:\sub1\sub3.ext.ext\name.gz';
122
 
          {$endif}
123
 
          SplitName (n, p, rn, e);
124
 
          Write ('"', n, '" => ',
125
 
                 'PATH = "', p, '", RAW NAME = "', rn,
126
 
                 '", EXTENSION = "', e, '"');
127
 
        end;
128
 
 
129
 
    end;
130
 
    if (ApiComm.GetErrorCode = errOK)
131
 
      then WriteLn (' <NO ERROR>')
132
 
      else WriteLn (' <ERROR>');
133
 
    inc (i);
134
 
  until (i = Passes);
135
 
  WriteLn ('---');
136
 
end.
 
 
b'\\ No newline at end of file'