testproto.pp 1.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 2005 by Marco van de Voort
  5. test netdb unit, /etc/protocols part
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$mode objfpc}
  13. {$h+}
  14. program testproto;
  15. uses netdb,Sockets;
  16. Procedure DumpProtoEntry(Const H : TProtocolEntry);
  17. begin
  18. With H do
  19. begin
  20. Writeln('Name : ',Name);
  21. Writeln('Number : ',Number);
  22. Writeln('Aliases : ',Aliases);
  23. Writeln;
  24. end;
  25. end;
  26. Procedure Testnumber(number : integer);
  27. Var
  28. H : TProtocolEntry;
  29. begin
  30. If GetProtocolByNumber(number,H) then
  31. DumpProtoEntry(H)
  32. else
  33. Writeln('No entry for number ',Number)
  34. end;
  35. Procedure TestName(Const N : string);
  36. Var
  37. H : TProtocolEntry;
  38. begin
  39. If GetProtocolByName(N,H) then
  40. DumpProtoEntry(H)
  41. else
  42. Writeln('No entry for protocol name ',N)
  43. end;
  44. var i : integer;
  45. begin
  46. testname('ip');
  47. testname('IP');
  48. testname('udp');
  49. testname('UDP');
  50. testname('xx'); // should fail
  51. for i:=0 to 10 do
  52. testnumber(i);
  53. testnumber(99); // should fail
  54. end.
  55. {
  56. $Log$
  57. Revision 1.1 2005-03-27 18:14:58 marco
  58. * new test
  59. }