Pārlūkot izejas kodu

Add test for issue #41384

Pierre Muller 1 nedēļu atpakaļ
vecāks
revīzija
b40e89d4c8
3 mainītis faili ar 112 papildinājumiem un 0 dzēšanām
  1. 7 0
      tests/webtbs/tw41384.pp
  2. 76 0
      tests/webtbs/u41384a.pp
  3. 29 0
      tests/webtbs/u41384b.pp

+ 7 - 0
tests/webtbs/tw41384.pp

@@ -0,0 +1,7 @@
+uses
+  u41384b;
+
+begin
+  Writeln('LocalHost address: ',LocalHostAddress.Address);
+end.
+

+ 76 - 0
tests/webtbs/u41384a.pp

@@ -0,0 +1,76 @@
+unit u41384a;
+
+{$mode ObjFPC}
+{$H+}
+{$modeswitch advancedrecords}
+
+interface
+
+uses
+  classes, sysutils;
+
+type
+
+  TAddressType = (atIN4, atIN6, atUnixSock);
+  TNetworkAddress = record
+    Address: String;
+    AddressType: TAddressType;
+  end;
+
+function isIPv4Address(const Address: String): Boolean; inline;
+function isIPv6Address(const Address: String): Boolean; inline;
+
+function NetAddr(const Address: String): TNetworkAddress;inline;
+function DefAddr : TNetworkAddress;
+
+implementation
+
+function do_count(const Address:String; sep: char): Word;
+var
+  i : longint;
+begin
+  do_count:=0;
+  for i:=1 to Length(Address) do
+    begin
+      if (Address[i]=sep) then
+        inc(do_count);
+    end;
+end;
+
+function isIPv4Address(const Address:String):Boolean;
+begin
+  Result := do_count(Address,'.')=3;
+end;
+
+function isIPv6Address(const Address:String):Boolean;
+begin
+  Result := do_count(Address,':')=5;
+end;
+
+{$ifndef SHOW_FIX}
+function DefAddr : TNetworkAddress;
+begin
+  DefAddr:=Default(TNetworkAddress);
+end;
+{$endif}
+
+function NetAddr(const Address: String): TNetworkAddress;
+begin
+ Result := Default(TNetworkAddress);
+  if isIPv4Address(Address) then
+    Result.AddressType := atIN4
+  else if isIPv6Address(Address) then
+    Result.AddressType := atIN6
+  else // Filenames can be pretty much anything
+    Result.AddressType := atUnixSock;
+  Result.Address := Address;
+end;
+
+{$ifdef SHOW_FIX}
+function DefAddr : TNetworkAddress;
+begin
+  DefAddr:=Default(TNetworkAddress);
+end;
+{$endif}
+
+end.

+ 29 - 0
tests/webtbs/u41384b.pp

@@ -0,0 +1,29 @@
+{$MODE objfpc}
+{$H+}
+{$inline on}
+
+unit u41384b;
+
+interface
+
+uses
+  SysUtils, Classes, u41384a;
+
+operator:=(const AStr:String):TNetworkAddress;
+
+var
+  DefaultAddress : TNetworkAddress;
+  LocalHostAddress : TNetworkAddress;
+
+implementation
+
+operator:=(const AStr:String):TNetworkAddress;
+begin
+  Result := NetAddr(AStr);
+end;
+
+begin
+  DefaultAddress:=Default(TNetworkAddress);
+  LocalHostAddress:='127.0.0.1';
+end.
+