← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/tests/test/units/objects/testobj.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/tests/test/units/objects/testobj.pp
 
1
Program Testobj;
 
2
 
 
3
uses Objects;
 
4
 
 
5
const
 
6
 { Possible error codes returned to DOS by this program }
 
7
 EXIT_NOERROR   = 0;
 
8
 EXIT_NOTIFF    = 1;
 
9
 EXIT_DOSERROR  = 2;
 
10
 
 
11
 
 
12
(*************************************************************************)
 
13
(* Create a stream error procedure which will be called on error of the  *)
 
14
(* stream. Will Terminate executing program, as well as display info     *)
 
15
(* on the type of error encountered.                                     *)
 
16
(*************************************************************************)
 
17
Procedure StreamErrorProcedure(Var S: TStream); FAR;
 
18
Begin
 
19
 If S.Status = StError then
 
20
 Begin
 
21
  WriteLn('ERROR: General Access failure. Halting');
 
22
  Halt(EXIT_DOSERROR);
 
23
 end;
 
24
 If S.Status = StInitError then
 
25
 Begin
 
26
  Write('ERROR: Cannot Init Stream. Halting. ');
 
27
  { SPECIFIC TO DOS STREAMS }
 
28
  Case S.ErrorInfo of
 
29
  2: WriteLn('File not found.');
 
30
  3: WriteLn('Path not found.');
 
31
  5: Writeln('Access denied.');
 
32
  else
 
33
    WriteLn;
 
34
  end;
 
35
  Halt(EXIT_DOSERROR);
 
36
 end;
 
37
 If S.Status = StReadError then
 
38
 Begin
 
39
  WriteLn('ERROR: Read beyond end of Stream. Halting');
 
40
  Halt(EXIT_DOSERROR);
 
41
 end;
 
42
 If S.Status = StWriteError then
 
43
 Begin
 
44
  WriteLn('ERROR: Cannot expand Stream. Halting');
 
45
  Halt(EXIT_DOSERROR);
 
46
 end;
 
47
 If S.Status = StGetError then
 
48
 Begin
 
49
  WriteLn('ERROR: Get of Unregistered type. Halting');
 
50
  Halt(EXIT_DOSERROR);
 
51
 end;
 
52
 If S.Status = StPutError then
 
53
 Begin
 
54
  WriteLn('ERROR: Put of Unregistered type. Halting');
 
55
  Halt(EXIT_DOSERROR);
 
56
 end;
 
57
end;
 
58
 
 
59
Procedure WriteInformation;
 
60
{ Writes information about the program }
 
61
Begin
 
62
   WriteLn('Usage: fname.ext to check');
 
63
   Halt(EXIT_NOERROR);
 
64
end;
 
65
 
 
66
{ Program to demonstrate the TDosStream object. }
 
67
 
 
68
 
 
69
Const S : String = '0123456789';
 
70
      P : Pchar = '9876543210';
 
71
 
 
72
Var Stream : TDosStream;
 
73
    Buf : String;
 
74
    L : word;
 
75
    f : file;
 
76
 
 
77
begin
 
78
  StreamError:= @StreamErrorProcedure;
 
79
  Writeln ('Writing to stream : "01234567899876543210"');
 
80
  Stream.Init('testobj.tmp',stCreate);
 
81
  Stream.WriteStr (@S);
 
82
  Stream.StrWrite (P);
 
83
  Writeln ('Closing stream.');
 
84
  Stream.Done;
 
85
  Writeln ('Reading from stream : ');
 
86
  Stream.Init('testobj.tmp',StOpenRead);
 
87
  WriteLn('After opening');
 
88
  Writeln ('Reading (',S,') : ',Stream.ReadStr^);
 
89
  Writeln ('Reading (',P,') : ',Stream.StrRead);
 
90
  Writeln ('Closing stream.');
 
91
  Stream.Done;
 
92
  Writeln ('Same thing, using raw read method : ');
 
93
  Writeln ('Reading from stream : ');
 
94
  Stream.Init('testobj.tmp',StOpenRead);
 
95
  Stream.Read (Buf,11);
 
96
  Writeln ('Reading (',S,') : ',Buf);
 
97
  Stream.Read  (L,2);
 
98
  Stream.Read (Buf[1],L);
 
99
  Buf[0]:=chr(L);
 
100
  Writeln ('Reading (',P,') : ',Buf);
 
101
  Writeln ('Closing stream.');
 
102
  Stream.Done;
 
103
  Writeln ('Statistics about stream : ');
 
104
  Stream.Init('testobj.tmp',StOpenRead);
 
105
  Writeln ('Size     : ',Stream.GetSize);
 
106
  Writeln ('Position : ',Stream.GetPos);
 
107
  Writeln ('Reading (',S,') : ',Stream.ReadStr^);
 
108
  L:=Stream.GetPos;
 
109
  Writeln ('Position : ',L);
 
110
  Writeln ('Closing stream.');
 
111
  Stream.Done;
 
112
  Writeln ('Reading from stream : ');
 
113
  Stream.Init('testobj.tmp',StOpenRead);
 
114
  Writeln ('Seek to position :',L);
 
115
  Stream.Seek(L);
 
116
  Writeln ('Reading (',P,') : ',Stream.StrRead);
 
117
  Writeln ('Closing stream.');
 
118
  Stream.Done;
 
119
  Writeln ('Truncating stream to zero length.');
 
120
  Stream.Init('testobj.tmp',StOpenWrite);
 
121
  Stream.Truncate;
 
122
  Stream.Done;
 
123
  Assign(f,'testobj.tmp');
 
124
  Erase(f);
 
125
end.