← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/tests/test/tparray10.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/tparray10.pp
 
1
{ based on gpc test pvs1 }
 
2
{ FLAG --extended-pascal }
 
3
 
 
4
{TEST 6.6.5.4-1, CLASS=CONFORMANCE}
 
5
 
 
6
{ This program tests that pack and unpack are
 
7
  implemented in this compiler as according to the
 
8
  Standard.
 
9
  The compiler fails if the program does not compile. }
 
10
 
 
11
program t6p6p5p4d1(output);
 
12
 
 
13
{$mode macpas}
 
14
 
 
15
type
 
16
   colourtype = (red,pink,orange,yellow,green,blue);
 
17
var
 
18
   unone    : array[3..24] of char;
 
19
   pacone   : packed array[1..4] of char;
 
20
   pacy     : array[1..4] of char;
 
21
   untwo    : array[4..8] of colourtype;
 
22
   pactwo   : packed array[6..7] of colourtype;
 
23
   i        : integer;
 
24
   colour   : colourtype;
 
25
   s: string;
 
26
begin
 
27
   pacone:='ABCD';
 
28
   pacy:=pacone;
 
29
   if pacy <> 'ABCD' then
 
30
     halt(1);
 
31
   s := pacone;
 
32
   unpack(pacone,unone,5);
 
33
   if (unone[3] <> #0) or
 
34
      (unone[4] <> #0) or
 
35
      (unone[5] <> 'A') or
 
36
      (unone[6] <> 'B') or
 
37
      (unone[7] <> 'C') or
 
38
      (unone[8] <> 'D') or
 
39
      (unone[9] <> #0) or
 
40
      (unone[10] <> #0) or
 
41
      (unone[11] <> #0) then
 
42
     halt(1);
 
43
   colour:=red;
 
44
   for i:=4 to 8 do
 
45
   begin
 
46
      untwo[i]:=colour;
 
47
      colour:=succ(colour)
 
48
   end;
 
49
   pack(untwo,5,pactwo);
 
50
   if (pactwo[6] <> pink) or
 
51
      (pactwo[7] <> orange) then
 
52
     halt(1);
 
53
   writeln('unone[5] = ''', unone[5], ''' = ', ord(unone[5]));
 
54
   if unone[5]='A' then
 
55
      writeln(' PASS...6.6.5.4-1')
 
56
   else
 
57
     begin
 
58
       writeln(' FAIL...6.6.5.4-1');
 
59
       halt(1);
 
60
     end;
 
61
end.
 
62