+ Add test to test Pascal I/O sockets

git-svn-id: trunk@5975 -

.gitattributes

@@ -6184,6 +6184,7 @@ tests/tbs/tb0520.pp svneol=native#text/plain
 tests/tbs/tb0521.pp svneol=native#text/plain
 tests/tbs/tb0522.pp svneol=native#text/plain
 tests/tbs/tb0523.pp svneol=native#text/plain
+tests/tbs/tb0524.pp svneol=native#text/x-pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain

tests/tbs/tb0524.pp

@@ -0,0 +1,113 @@
+program tb0523;
+
+uses sockets,baseunix;
+
+const port=6667;
+
+ function rawport_to_netport(const raw_port:word):word;
+ begin
+  rawport_to_netport := swap(raw_port);
+ end;
+
+procedure do_server;
+
+var s,t:string;
+    lsock,usock:longint;
+    saddr:Tinetsockaddr;
+    len:longInt;
+    sin,sout:text;
+    raw_port:word;
+    i:byte;
+
+begin
+   lsock:=socket(af_inet,sock_stream,0);
+   if lsock=-1 then
+     begin
+       writeln(socketerror);
+       halt(1);
+     end;
+
+  with saddr do
+    begin
+      family:=af_inet;
+      port:=ntobe(word(6667));
+      addr:=0;
+   end;
+
+  if not bind(lsock,saddr,sizeof(saddr)) then
+    begin
+      writeln(socketerror);
+      halt(1);
+    end;
+
+  if not listen(lsock,1) then
+    begin
+      writeln(socketerror);
+      halt(1);
+    end;
+
+  len:=sizeof(saddr);
+  usock:=accept(lsock,saddr,len);
+  if usock=-1 then
+    begin
+      writeln(SocketError);
+      halt(1);
+    end;
+  sock2text(usock,sin,sout);
+
+  reset(sin);
+  rewrite(sout);
+  repeat
+    readln(sin,s);
+    t:='';
+    for i:=length(s) downto 1 do
+      t:=t+s[i];
+    writeln(sout,t);
+  until eof(sin);
+  close(sin);
+  close(sout);
+  shutdown(usock,2);
+end;
+
+procedure do_client;
+
+var s:sizeint;
+    saddr:Tinetsockaddr;
+    sin,sout:text;
+    str:ansistring;
+
+begin
+   s:=socket(af_inet,sock_stream,0);
+   saddr.sin_family:=af_inet;
+   saddr.sin_port:=htons(port);
+   saddr.sin_addr.s_addr:=hosttonet($7f000001); {127.0.0.1}
+   if connect(s,saddr,sin,sout)=false then
+     begin
+       writeln(socketerror);
+       halt(1);
+     end;
+   writeln(sout,'abcd');
+   readln(sin,str);
+   if str<>'dcba' then
+     halt(1);
+   writeln(sout,'1234');
+   readln(sin,str);
+   if str<>'4321' then
+     halt(1);
+   close(sin);
+   close(sout);
+   shutdown(s,2);
+end;
+
+var i:longint;
+
+begin
+  if fpfork=0 then
+    do_server
+  else
+    begin
+      {Give server some time to start.}
+      for i:=1 to 1000000 do;
+      do_client;
+    end;
+end.