treadwrt.pp 2.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117
  1. {$i+}
  2. { Widestring is not supported in 1.0.x }
  3. {$ifndef VER1_0}
  4. {$define HASWIDESTR}
  5. {$endif VER1_0}
  6. procedure test_rwtext;
  7. var
  8. t: text;
  9. s: shortstring;
  10. a: ansistring;
  11. {$ifdef HASWIDESTR}
  12. wc : widechar;
  13. w : widestring;
  14. {$endif HASWIDESTR}
  15. l: longint;
  16. card: cardinal;
  17. b: byte; bool: boolean;
  18. c: char;
  19. arr: array[1..10] of char;
  20. p: pchar;
  21. r: real;
  22. begin
  23. bool := true;
  24. writeln('ShortString const test');
  25. writeln('ShortString const test with const len':70);
  26. b := 60;
  27. writeln('ShortString const test with var len':b);
  28. s := 'ShortStr var test';
  29. writeln(s);
  30. s := s+ ' with const len';
  31. writeln(s:40);
  32. s := 'ShortStr var test with var len';
  33. writeln(s:b);
  34. l := -1; c := 'y'; card := 18; r := 5.1234;
  35. writeln('A combo test: ',b,' ',l,' ',c,' ',card,' ',bool:10);
  36. writeln('floats: ',r,' ',r:1,' ',r:8,' ',r:10:2);
  37. arr := 'arrofchars';
  38. writeln('array of char: ',arr:38);
  39. arr[10] := #0;
  40. p := @arr;
  41. writeln('pchar test: ',p);
  42. a := 'this is an ansistring';
  43. writeln(a);
  44. {$ifdef HASWIDESTR}
  45. wc := 'y';
  46. writeln('widechar: ',wc);
  47. w := 'this is a widestring';
  48. writeln(w);
  49. {$endif HASWIDESTR}
  50. write('no new line now...',l,c,b);
  51. write;
  52. read;
  53. assign(t,'treadwrt.txt');
  54. rewrite(t);
  55. writeln('testing text file functionality...');
  56. writeln(t,'this is a string');
  57. writeln(t,l);
  58. writeln(t,c);
  59. writeln(t,b);
  60. l := 0;
  61. c := #32;
  62. b := 5;
  63. close(t);
  64. reset(t);
  65. readln(t,s);
  66. if s <> 'this is a string' then
  67. halt(1);
  68. readln(t,l);
  69. if l <> -1 then
  70. halt(1);
  71. readln(t,c);
  72. if c <> 'y' then
  73. halt(1);
  74. readln(t,b);
  75. if b <> 60 then
  76. halt(1);
  77. close(t);
  78. erase(t);
  79. writeln('write/read text passed...');
  80. end;
  81. procedure test_rwtyped;
  82. var
  83. f: file of cardinal;
  84. c: cardinal;
  85. begin
  86. assign(f,'treadwrt.dat');
  87. rewrite(f);
  88. c := 8;
  89. write(f,c);
  90. write(f,cardinal(10));
  91. close(f);
  92. reset(f);
  93. read(f,c);
  94. if c <> 8 then
  95. halt(1);
  96. read(f,c);
  97. if c <> 10 then
  98. halt(1);
  99. close(f);
  100. erase(f);
  101. writeln('write/read typed passed...');
  102. end;
  103. begin
  104. test_rwtext;
  105. test_rwtyped;
  106. end.