← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/tests/test/units/system/tseg.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/system/tseg.pp
 
1
{ Part of System unit testsuit        }
 
2
{ Carl Eric Codere Copyright (c) 2002 }
 
3
program tseg;
 
4
 
 
5
const
 
6
 cst : integer = 0;
 
7
var
 
8
 variable : integer;
 
9
 
 
10
procedure fail;
 
11
 begin
 
12
  WriteLn('Failure!');
 
13
  halt(1);
 
14
 end;
 
15
 
 
16
procedure test_cseg;
 
17
 begin
 
18
   Write('Testing CSeg()...');
 
19
   if cseg <> 0 then
 
20
     fail
 
21
   else
 
22
     WriteLn('Success!');
 
23
 end;
 
24
 
 
25
procedure test_dseg;
 
26
 begin
 
27
   Write('Testing DSeg()...');
 
28
   if dseg <> 0 then
 
29
     fail
 
30
   else
 
31
     WriteLn('Success!');
 
32
 end;
 
33
 
 
34
procedure test_sseg;
 
35
 begin
 
36
   Write('Testing SSeg()...');
 
37
   if sseg <> 0 then
 
38
     fail
 
39
   else
 
40
     WriteLn('Success!');
 
41
 end;
 
42
 
 
43
procedure test_seg;
 
44
 var
 
45
   x : longint;
 
46
   _result : boolean;
 
47
 begin
 
48
   _result := true;
 
49
   Write('Testing Seg()...');
 
50
   if seg(x) <> 0 then
 
51
     _result := false;
 
52
   if seg(cst) <> 0 then
 
53
     _result := false;
 
54
   if seg(variable) <> 0 then
 
55
     _result := false;
 
56
   if not _result then
 
57
     fail
 
58
   else
 
59
     WriteLn('Success!');
 
60
 end;
 
61
 
 
62
Begin
 
63
  test_cseg;
 
64
  test_dseg;
 
65
  test_seg;
 
66
  test_sseg;
 
67
end.