← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/tests/test/cg/tprintf2.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/cg/tprintf2.pp
 
1
{ %version=1.1 }
 
2
{ %NOTE=This test requires a C library }
 
3
 
 
4
{$mode objfpc}
 
5
 
 
6
uses
 
7
  strings;
 
8
 
 
9
{$ifdef FPC_HAS_TYPE_EXTENDED}
 
10
{$define TEST_EXTENDED}
 
11
{$endif FPC_HAS_TYPE_EXTENDED}
 
12
 
 
13
{$ifdef WINDOWS}
 
14
const
 
15
{$ifdef wince}
 
16
  CrtLib = 'coredll.dll';
 
17
{$else}
 
18
  { the msvcrt.dll doesn't support extended because MS-C doesn't }
 
19
  {$undef TEST_EXTENDED}
 
20
  CrtLib = 'msvcrt.dll';
 
21
{$endif}
 
22
 
 
23
procedure printf(const formatstr : pchar); varargs; cdecl; external CrtLib name 'printf';
 
24
procedure sprintf(p : pchar;const formatstr : pchar); varargs; cdecl; external CrtLib name 'sprintf';
 
25
const
 
26
  int64prefix='I64';
 
27
{$else}
 
28
{$linklib c}
 
29
procedure printf(const formatstr : pchar); varargs; cdecl; external;
 
30
procedure sprintf(p : pchar;const formatstr : pchar); varargs; cdecl; external;
 
31
const
 
32
  int64prefix='ll';
 
33
{$endif}
 
34
 
 
35
const
 
36
{$ifdef macos}
 
37
  lineending = #13;
 
38
{$else}
 
39
  lineending = #10;
 
40
{$endif}
 
41
 
 
42
 
 
43
type
 
44
 THandle = longint;
 
45
const
 
46
  l : longint = 45;
 
47
  ll : int64 = 345;
 
48
  s : pchar = 'Enclosed text';
 
49
  s2 : pchar = 'next';
 
50
  si : single = 32.12;
 
51
  d : double = 45.45;
 
52
  e : extended = 74.74;
 
53
  p : pchar = nil;
 
54
  has_errors : boolean = false;
 
55
 
 
56
begin
 
57
  getmem(p,500);
 
58
 
 
59
  Writeln('Testing C printf function called from FPC code');
 
60
  { for some CPUs, this requires also different calling conventions
 
61
    than procedures taking a single pchar parameter, see #7504 (FK) }
 
62
  printf('Simple test without arg'+lineending);
 
63
 
 
64
  Writeln('Testing with single pchar argument');
 
65
  printf('Text containing "%s" text'+lineending,s);
 
66
  sprintf(p,'Text containing "%s" text'+lineending,s);
 
67
  if strpos(p,'g "Enclosed text" ')=nil then
 
68
    begin
 
69
      writeln('The output of sprintf for pchar is wrong: ',p);
 
70
      has_errors:=true;
 
71
    end;
 
72
 
 
73
  Writeln('Testing with single longint argument');
 
74
  printf('Text containing longint: %d'+lineending,l);
 
75
  sprintf(p,'Text containing longint: %d'+lineending,l);
 
76
  if strpos(p,'longint: 45')=nil then
 
77
    begin
 
78
      writeln('The output of sprintf for longint is wrong: ',p);
 
79
      has_errors:=true;
 
80
    end;
 
81
 
 
82
  Writeln('Testing with single int64 argument');
 
83
  printf('Text containing int64: %'+int64prefix+'d'+lineending,ll);
 
84
  sprintf(p,'Text containing int64: %'+int64prefix+'d'+lineending,ll);
 
85
  if strpos(p,'int64: 345')=nil then
 
86
    begin
 
87
      writeln('The output of sprintf for int64 is wrong: ',p);
 
88
      has_errors:=true;
 
89
    end;
 
90
 
 
91
  Writeln('Testing with single single argument');
 
92
  printf('Text containing single: %f'+lineending,si);
 
93
  sprintf(p,'Text containing single: %f'+lineending,si);
 
94
  if strpos(p,'single: 32.1')=nil then
 
95
    begin
 
96
      writeln('The output of sprintf for double is wrong: ',p);
 
97
      has_errors:=true;
 
98
    end;
 
99
 
 
100
  Writeln('Testing with single double argument');
 
101
  printf('Text containing double: %lf'+lineending,d);
 
102
  sprintf(p,'Text containing double: %lf'+lineending,d);
 
103
  if strpos(p,'double: 45.4')=nil then
 
104
    begin
 
105
      writeln('The output of sprintf for double is wrong: ',p);
 
106
      has_errors:=true;
 
107
    end;
 
108
 
 
109
{$ifdef TEST_EXTENDED}
 
110
  printf('Text containing long double: %Lf'+lineending,e);
 
111
  sprintf(p,'Text containing long double: %Lf'+lineending,e);
 
112
  if strpos(p,'long double: 74.7')=nil then
 
113
    begin
 
114
      writeln('The output of sprintf for long double is wrong:',p);
 
115
      has_errors:=true;
 
116
    end;
 
117
{$endif TEST_EXTENDED}
 
118
 
 
119
  Writeln('Testing with combined pchar argument');
 
120
  printf('Text containing "%s" and "%s" text'+lineending,s,s2);
 
121
  sprintf(p,'Text containing "%s" and "%s" text'+lineending,s,s2);
 
122
  if strpos(p,'g "Enclosed text" and "next"')=nil then
 
123
    begin
 
124
      writeln('The output of sprintf for two pchars is wrong: ',p);
 
125
      has_errors:=true;
 
126
    end;
 
127
 
 
128
  Writeln('Testing with single longint argument and pchar');
 
129
  printf('Text containing longint: %d"%s"'+lineending,l,s2);
 
130
  sprintf(p,'Text containing longint: %d"%s"'+lineending,l,s2);
 
131
  if strpos(p,'longint: 45"next"')=nil then
 
132
    begin
 
133
      writeln('The output of sprintf for longint is wrong: ',p);
 
134
      has_errors:=true;
 
135
    end;
 
136
 
 
137
  Writeln('Testing with single int64 argument and pchar');
 
138
  printf('Text containing int64: %'+int64prefix+'d"%s"'+lineending,ll,s2);
 
139
  sprintf(p,'Text containing int64: %'+int64prefix+'d"%s"'+lineending,ll,s2);
 
140
  if strpos(p,'int64: 345"next"')=nil then
 
141
    begin
 
142
      writeln('The output of sprintf for int64 is wrong: ',p);
 
143
      has_errors:=true;
 
144
    end;
 
145
 
 
146
  Writeln('Testing with single single argument');
 
147
  printf('Text containing single: %f"%s"'+lineending,si,s2);
 
148
  sprintf(p,'Text containing single: %f"%s"'+lineending,si,s2);
 
149
  if (strpos(p,'single: 32.1')=nil) or
 
150
     (strpos(p,'"next"')=nil) then
 
151
    begin
 
152
      writeln('The output of sprintf for double is wrong: ',p);
 
153
      has_errors:=true;
 
154
    end;
 
155
 
 
156
  Writeln('Testing with single double argument');
 
157
  printf('Text containing double: %lf"%s"'+lineending,d,s2);
 
158
  sprintf(p,'Text containing double: %lf"%s"'+lineending,d,s2);
 
159
  if (strpos(p,'double: 45.4')=nil) or
 
160
     (strpos(p,'"next"')=nil) then
 
161
    begin
 
162
      writeln('The output of sprintf for double is wrong: ',p);
 
163
      has_errors:=true;
 
164
    end;
 
165
 
 
166
{$ifdef TEST_EXTENDED}
 
167
  printf('Text containing long double: %Lf"%s"'+lineending,e,s2);
 
168
  sprintf(p,'Text containing long double: %Lf"%s"'+lineending,e,s2);
 
169
  if (strpos(p,'long double: 74.7')=nil) or
 
170
     (strpos(p,'"next"')=nil) then
 
171
    begin
 
172
      writeln('The output of sprintf for long double is wrong:',p);
 
173
      has_errors:=true;
 
174
    end;
 
175
{$endif TEST_EXTENDED}
 
176
 
 
177
  if has_errors then
 
178
    halt(1);
 
179
end.