← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/tests/test/cg/tcnvstr1.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/tcnvstr1.pp
 
1
{****************************************************************}
 
2
{  CODE GENERATOR TEST PROGRAM                                   }
 
3
{  Copyright (c) 2002, Carl Eric Codere                          }
 
4
{****************************************************************}
 
5
{ NODE TESTED : secondtypeconvert() -> second_string_string      }
 
6
{****************************************************************}
 
7
{ PRE-REQUISITES: secondload()                                   }
 
8
{                 secondassign()                                 }
 
9
{                 secondtypeconv()                               }
 
10
{****************************************************************}
 
11
{ DEFINES:                                                       }
 
12
{            FPC     = Target is FreePascal compiler             }
 
13
{****************************************************************}
 
14
{ REMARKS: Same type short conversion is not tested, except for  }
 
15
{          shortstrings , since it requires special handling.    }
 
16
{                                                                }
 
17
{                                                                }
 
18
{****************************************************************}
 
19
 
 
20
{$ifdef fpc}
 
21
{$mode objfpc}
 
22
  {$ifndef ver1_0}
 
23
    {$define haswidestring}
 
24
  {$endif}
 
25
{$else}
 
26
  {$ifndef ver70}
 
27
    {$define haswidestring}
 
28
  {$endif}
 
29
{$endif}
 
30
 
 
31
{$H+}
 
32
 
 
33
const
 
34
  { exactly 255 characters in length }
 
35
  BIG_STRING =
 
36
' This is a small text documentation to verify the validity of'+
 
37
' the string conversion routines. Of course the conversion routines'+
 
38
' should normally work like a charm, and this can only test that there'+
 
39
' aren''t any problems with maximum length strings. This fix!';
 
40
  { < 255 characters in length }
 
41
  SMALL_STRING = 'This is a small hello!';
 
42
  { > 255 characters in length }
 
43
  HUGE_STRING_END = ' the goal of this experiment';
 
44
  HUGE_STRING =
 
45
' This is a huge text documentation to verify the validity of'+
 
46
' the string conversion routines. Of course the conversion routines'+
 
47
' should normally work like a charm, and this can only test that there'+
 
48
' aren''t any problems with maximum length strings. I hope you understand'+
 
49
HUGE_STRING_END;
 
50
  EMPTY_STRING = '';
 
51
 
 
52
type
 
53
  shortstr = string[127];
 
54
var
 
55
 s2: shortstr;
 
56
 str_ansi: ansistring;
 
57
 str_short: shortstring;
 
58
{$ifdef haswidestring}
 
59
 str_wide : widestring;
 
60
{$endif}
 
61
 
 
62
 
 
63
procedure fail;
 
64
 begin
 
65
   WriteLn('Failure!');
 
66
   Halt(1);
 
67
 end;
 
68
 
 
69
 
 
70
procedure test_ansi_to_short;
 
71
begin
 
72
 {************************************************************************}
 
73
 {                          ansistring -> shortstring                     }
 
74
 {************************************************************************}
 
75
 WriteLn('Test ansistring -> shortstring');
 
76
 { ansistring -> shortstring }
 
77
 str_short := '';
 
78
 str_ansi:='';
 
79
 str_ansi := SMALL_STRING;
 
80
 str_short:=str_ansi;
 
81
 Write('small ansistring -> shortstring...');
 
82
 if str_short = str_ansi then
 
83
   WriteLn('Success.')
 
84
 else
 
85
   fail;
 
86
 
 
87
 str_short := '';
 
88
 str_ansi:='';
 
89
 str_ansi := EMPTY_STRING;
 
90
 str_short:=str_ansi;
 
91
 Write('empty ansistring -> shortstring...');
 
92
 if str_short = str_ansi then
 
93
   WriteLn('Success.')
 
94
 else
 
95
   fail;
 
96
 
 
97
 
 
98
 str_short := '';
 
99
 str_ansi:='';
 
100
 str_ansi := BIG_STRING;
 
101
 str_short:=str_ansi;
 
102
 Write('big ansistring -> shortstring...');
 
103
 if str_short = str_ansi then
 
104
   WriteLn('Success.')
 
105
 else
 
106
   fail;
 
107
 
 
108
 
 
109
 Write('huge ansistring -> shortstring...');
 
110
 str_short := '';
 
111
 str_ansi:='';
 
112
 str_ansi := HUGE_STRING;
 
113
 str_short:=str_ansi;
 
114
 { Delphi 3/Delphi 6 does not consider these as the same string }
 
115
 if str_short <> str_ansi then
 
116
   WriteLn('Success.')
 
117
 else
 
118
   fail;
 
119
{}
 
120
 s2 := '';
 
121
 str_ansi:='';
 
122
 str_ansi := SMALL_STRING;
 
123
 s2:=str_ansi;
 
124
 Write('small ansistring -> shortstring...');
 
125
 if s2 = str_ansi then
 
126
   WriteLn('Success.')
 
127
 else
 
128
   fail;
 
129
 
 
130
 s2 := '';
 
131
 str_ansi:='';
 
132
 str_ansi := EMPTY_STRING;
 
133
 s2:=str_ansi;
 
134
 Write('empty ansistring -> shortstring...');
 
135
 if s2 = str_ansi then
 
136
   WriteLn('Success.')
 
137
 else
 
138
   fail;
 
139
 
 
140
 s2 := '';
 
141
 str_ansi:='';
 
142
 str_ansi := BIG_STRING;
 
143
 s2:=str_ansi;
 
144
 Write('big ansistring -> shortstring...');
 
145
 { Should fail, since comparing different string lengths }
 
146
 if s2 <> str_ansi then
 
147
   WriteLn('Success.')
 
148
 else
 
149
   fail;
 
150
 
 
151
 s2 := '';
 
152
 str_ansi:='';
 
153
 str_ansi := HUGE_STRING;
 
154
 s2:=str_ansi;
 
155
 Write('huge ansistring -> shortstring...');
 
156
 { Should fail, since comparing different string lengths }
 
157
 if s2 <> str_ansi then
 
158
   WriteLn('Success.')
 
159
 else
 
160
   fail;
 
161
end;
 
162
 
 
163
 
 
164
procedure test_short_to_short;
 
165
begin
 
166
 {************************************************************************}
 
167
 {                         shortstring -> shortstring                     }
 
168
 {************************************************************************}
 
169
 WriteLn('Test shortstring -> shortstring...');
 
170
 { shortstring -> shortstring }
 
171
 str_short := '';
 
172
 s2:='';
 
173
 s2 := SMALL_STRING;
 
174
 str_short:=s2;
 
175
 Write('small shortstring -> shortstring...');
 
176
 if str_short = s2 then
 
177
   WriteLn('Success.')
 
178
 else
 
179
   fail;
 
180
 
 
181
 str_short := '';
 
182
 s2:='';
 
183
 s2 := EMPTY_STRING;
 
184
 str_short:=s2;
 
185
 Write('empty shortstring -> shortstring...');
 
186
 if str_short = s2 then
 
187
   WriteLn('Success.')
 
188
 else
 
189
   fail;
 
190
 
 
191
{$ifdef fpc}
 
192
{ Delphi does not compile these }
 
193
 str_short := '';
 
194
 s2:='';
 
195
 s2 := BIG_STRING;
 
196
 str_short:=s2;
 
197
 Write('big shortstring -> shortstring...');
 
198
 if str_short = s2 then
 
199
   WriteLn('Success.')
 
200
 else
 
201
   fail;
 
202
 
 
203
 
 
204
 str_short := '';
 
205
 s2:='';
 
206
 s2 := HUGE_STRING;
 
207
 str_short:=s2;
 
208
 Write('huge shortstring -> shortstring...');
 
209
 { Delphi 3/Delphi 6 does not consider these as the same string }
 
210
 if str_short = s2 then
 
211
   WriteLn('Success.')
 
212
 else
 
213
   fail;
 
214
{$endif}
 
215
 
 
216
 s2 := '';
 
217
 str_short:='';
 
218
 str_short := SMALL_STRING;
 
219
 Write('small shortstring -> shortstring...');
 
220
 s2:=str_short;
 
221
 if s2 = str_short then
 
222
   WriteLn('Success.')
 
223
 else
 
224
   fail;
 
225
 
 
226
 s2 := '';
 
227
 str_short:='';
 
228
 str_short := EMPTY_STRING;
 
229
 Write('empty shortstring -> shortstring...');
 
230
 s2:=str_short;
 
231
 if s2 = str_short then
 
232
   WriteLn('Success.')
 
233
 else
 
234
   fail;
 
235
 
 
236
 s2 := '';
 
237
 str_short:='';
 
238
 str_short := BIG_STRING;
 
239
 Write('big shortstring -> shortstring...');
 
240
 s2:=str_short;
 
241
 { Should fail, since comparing different string lengths }
 
242
 if s2 <> str_short then
 
243
   WriteLn('Success.')
 
244
 else
 
245
   fail;
 
246
 
 
247
{$ifdef fpc}
 
248
 s2 := '';
 
249
 str_short:='';
 
250
 str_short := HUGE_STRING;
 
251
 Write('huge shortstring -> shortstring...');
 
252
 s2:=str_short;
 
253
 { Should fail, since comparing different string lengths }
 
254
 if s2 <> str_short then
 
255
   WriteLn('Success.')
 
256
 else
 
257
   fail;
 
258
{$endif}
 
259
end;
 
260
 
 
261
 
 
262
procedure test_short_to_ansi;
 
263
begin
 
264
 {************************************************************************}
 
265
 {                         shortstring -> ansistring                      }
 
266
 {************************************************************************}
 
267
 WriteLn('Test shortstring -> ansistring');
 
268
 Write('small shortstring -> ansistring...');
 
269
 { shortstring -> ansistring }
 
270
 str_short := SMALL_STRING;
 
271
 str_ansi:=str_short;
 
272
 if str_short = str_ansi then
 
273
   WriteLn('Success.')
 
274
 else
 
275
   fail;
 
276
 
 
277
 Write('empty shortstring -> ansistring...');
 
278
 str_short := EMPTY_STRING;
 
279
 str_ansi:=str_short;
 
280
 if str_short = str_ansi then
 
281
   WriteLn('Success.')
 
282
 else
 
283
   fail;
 
284
 
 
285
 Write('big shortstring -> ansistring...');
 
286
 str_short := BIG_STRING;
 
287
 str_ansi:=str_short;
 
288
 if str_short = str_ansi then
 
289
   WriteLn('Success.')
 
290
 else
 
291
   fail;
 
292
 
 
293
 Write('small shortstring -> ansistring...');
 
294
 { shortstring -> ansistring }
 
295
 s2 := SMALL_STRING;
 
296
 str_ansi:=s2;
 
297
 if s2 = str_ansi then
 
298
   WriteLn('Success.')
 
299
 else
 
300
   fail;
 
301
 
 
302
 Write('empty shortstring -> ansistring...');
 
303
 s2 := EMPTY_STRING;
 
304
 str_ansi:=s2;
 
305
 if s2 = str_ansi then
 
306
   WriteLn('Success.')
 
307
 else
 
308
   fail;
 
309
 
 
310
end;
 
311
 
 
312
 
 
313
{$ifdef haswidestring}
 
314
procedure test_wide_to_ansi;
 
315
begin
 
316
 {************************************************************************}
 
317
 {                         widestring -> ansistring                      }
 
318
 {************************************************************************}
 
319
 WriteLn('Test widestring -> ansistring');
 
320
 Write('small widestring -> ansistring...');
 
321
 { widestring -> ansistring }
 
322
 str_wide := SMALL_STRING;
 
323
 str_ansi:=str_wide;
 
324
 if str_wide = str_ansi then
 
325
   WriteLn('Success.')
 
326
 else
 
327
   fail;
 
328
 
 
329
 Write('empty widestring -> ansistring...');
 
330
 str_wide := EMPTY_STRING;
 
331
 str_ansi:=str_wide;
 
332
 if str_wide = str_ansi then
 
333
   WriteLn('Success.')
 
334
 else
 
335
   fail;
 
336
 
 
337
 Write('big widestring -> ansistring...');
 
338
 str_wide := BIG_STRING;
 
339
 str_ansi:=str_wide;
 
340
 if str_wide = str_ansi then
 
341
   WriteLn('Success.')
 
342
 else
 
343
   fail;
 
344
 
 
345
 Write('huge widestring -> ansistring...');
 
346
 str_wide := HUGE_STRING;
 
347
 str_ansi:=str_wide;
 
348
 if str_wide = str_ansi then
 
349
   WriteLn('Success.')
 
350
 else
 
351
   fail;
 
352
 
 
353
end;
 
354
 
 
355
 
 
356
 
 
357
procedure test_short_to_wide;
 
358
begin
 
359
 {************************************************************************}
 
360
 {                         shortstring -> widestring                      }
 
361
 {************************************************************************}
 
362
 WriteLn('Test shortstring -> widestring');
 
363
 Write('small shortstring -> widestring...');
 
364
 { shortstring -> widestring }
 
365
 str_short := SMALL_STRING;
 
366
 str_wide:=str_short;
 
367
 if str_short = str_wide then
 
368
   WriteLn('Success.')
 
369
 else
 
370
   fail;
 
371
 
 
372
 Write('empty shortstring -> widestring...');
 
373
 str_short := EMPTY_STRING;
 
374
 str_wide:=str_short;
 
375
 if str_short = str_wide then
 
376
   WriteLn('Success.')
 
377
 else
 
378
   fail;
 
379
 
 
380
 Write('big shortstring -> widestring...');
 
381
 str_short := BIG_STRING;
 
382
 str_wide:=str_short;
 
383
 if str_short = str_wide then
 
384
   WriteLn('Success.')
 
385
 else
 
386
   fail;
 
387
 
 
388
 Write('small shortstring -> widestring...');
 
389
 { shortstring -> widestring }
 
390
 s2 := SMALL_STRING;
 
391
 str_wide:=s2;
 
392
 if s2 = str_wide then
 
393
   WriteLn('Success.')
 
394
 else
 
395
   fail;
 
396
 
 
397
 Write('empty shortstring -> widestring...');
 
398
 s2 := EMPTY_STRING;
 
399
 str_wide:=s2;
 
400
 if s2 = str_wide then
 
401
   WriteLn('Success.')
 
402
 else
 
403
   fail;
 
404
 
 
405
end;
 
406
 
 
407
 
 
408
procedure test_ansi_to_wide;
 
409
begin
 
410
 {************************************************************************}
 
411
 {                         ansistring -> widestring                      }
 
412
 {************************************************************************}
 
413
 WriteLn('Test ansistring -> widestring');
 
414
 Write('small ansistring -> widestring...');
 
415
 { ansistring -> widestring }
 
416
 str_ansi := SMALL_STRING;
 
417
 str_wide:=str_ansi;
 
418
 if str_ansi = str_wide then
 
419
   WriteLn('Success.')
 
420
 else
 
421
   fail;
 
422
 
 
423
 Write('empty ansistring -> widestring...');
 
424
 str_ansi := EMPTY_STRING;
 
425
 str_wide:=str_ansi;
 
426
 if str_ansi = str_wide then
 
427
   WriteLn('Success.')
 
428
 else
 
429
   fail;
 
430
 
 
431
 Write('big ansistring -> widestring...');
 
432
 str_ansi := BIG_STRING;
 
433
 str_wide:=str_ansi;
 
434
 if str_ansi = str_wide then
 
435
   WriteLn('Success.')
 
436
 else
 
437
   fail;
 
438
 
 
439
 Write('small ansistring -> widestring...');
 
440
 { ansistring -> widestring }
 
441
 s2 := SMALL_STRING;
 
442
 str_wide:=s2;
 
443
 if s2 = str_wide then
 
444
   WriteLn('Success.')
 
445
 else
 
446
   fail;
 
447
 
 
448
 Write('empty ansistring -> widestring...');
 
449
 s2 := EMPTY_STRING;
 
450
 str_wide:=s2;
 
451
 if s2 = str_wide then
 
452
   WriteLn('Success.')
 
453
 else
 
454
   fail;
 
455
 
 
456
end;
 
457
 
 
458
 
 
459
 
 
460
procedure test_wide_to_short;
 
461
begin
 
462
 {************************************************************************}
 
463
 {                          widestring -> shortstring                     }
 
464
 {************************************************************************}
 
465
 WriteLn('Test widestring -> shortstring');
 
466
 { widestring -> shortstring }
 
467
 str_short := '';
 
468
 str_wide:='';
 
469
 str_wide := SMALL_STRING;
 
470
 Write('small widestring -> shortstring...');
 
471
 str_short:=str_wide;
 
472
 if str_short = str_wide then
 
473
   WriteLn('Success.')
 
474
 else
 
475
   fail;
 
476
 
 
477
 str_short := '';
 
478
 str_wide:='';
 
479
 str_wide := EMPTY_STRING;
 
480
 Write('empty widestring -> shortstring...');
 
481
 str_short:=str_wide;
 
482
 if str_short = str_wide then
 
483
   WriteLn('Success.')
 
484
 else
 
485
   fail;
 
486
 
 
487
 
 
488
 Write('big widestring -> shortstring...');
 
489
 str_short := '';
 
490
 str_wide:='';
 
491
 str_wide := BIG_STRING;
 
492
 str_short:=str_wide;
 
493
 if str_short = str_wide then
 
494
   WriteLn('Success.')
 
495
 else
 
496
   fail;
 
497
 
 
498
 Write('huge widestring -> shortstring...');
 
499
 str_wide := HUGE_STRING;
 
500
 str_short:=str_wide;
 
501
 if str_short <> str_wide then
 
502
   WriteLn('Success.')
 
503
 else
 
504
   fail;
 
505
 
 
506
{}
 
507
 Write('small widestring -> shortstring...');
 
508
 s2 := '';
 
509
 str_wide:='';
 
510
 str_wide := SMALL_STRING;
 
511
 s2:=str_wide;
 
512
 if s2 = str_wide then
 
513
   WriteLn('Success.')
 
514
 else
 
515
   fail;
 
516
 
 
517
 Write('empty widestring -> shortstring...');
 
518
 s2 := '';
 
519
 str_wide:='';
 
520
 str_wide := EMPTY_STRING;
 
521
 s2:=str_wide;
 
522
 if s2 = str_wide then
 
523
   WriteLn('Success.')
 
524
 else
 
525
   fail;
 
526
 
 
527
 Write('big widestring -> shortstring...');
 
528
 s2 := '';
 
529
 str_wide:='';
 
530
 str_wide := BIG_STRING;
 
531
 s2:=str_wide;
 
532
 if s2 <> str_wide then
 
533
   WriteLn('Success.')
 
534
 else
 
535
   fail;
 
536
 
 
537
 Write('huge widestring -> shortstring...');
 
538
 s2 := '';
 
539
 str_wide:='';
 
540
 str_wide := HUGE_STRING;
 
541
 s2:=str_wide;
 
542
 if s2 <> str_wide then
 
543
   WriteLn('Success.')
 
544
 else
 
545
   fail;
 
546
end;
 
547
{$endif}
 
548
 
 
549
Begin
 
550
 test_ansi_to_short;
 
551
 test_short_to_short;
 
552
 test_short_to_ansi;
 
553
 { requires widestring support }
 
554
{$ifdef haswidestring}
 
555
 test_short_to_wide;
 
556
 test_ansi_to_wide;
 
557
 test_wide_to_short;
 
558
 test_wide_to_ansi;
 
559
{$endif}
 
560
End.