Browse Source

+ two new files

pierre 25 years ago
parent
commit
187c6ddc30
2 changed files with 99 additions and 0 deletions
  1. 32 0
      tests/webtbs/tbug961.pp
  2. 67 0
      tests/webtbs/tbug966.pp

+ 32 - 0
tests/webtbs/tbug961.pp

@@ -0,0 +1,32 @@
+{ older ppc386 only define cpu86 }
+{$ifdef cpu86}
+{$define cpui386}
+{$endif cpu86}
+var
+ x,y : byte;
+ z : longint;
+{$asmmode intel}
+
+procedure test(var x : byte);
+begin
+  x:=5;
+{$ifdef cpui386}
+  asm
+    mov   edi,$12345678
+    mov   edi,x
+    mov   [edi],78
+  end;
+{$else cpui386}
+  x:=$78;
+{$endif cpui386}
+end;
+
+begin
+  x:=34;
+  test(x);
+  if x<>78 then
+    begin
+      Writeln('Problem !!');
+      Halt(1);
+    end;
+end.

+ 67 - 0
tests/webtbs/tbug966.pp

@@ -0,0 +1,67 @@
+{ Source provided for Free Pascal Bug Report 966 }
+{$i-}
+{$ifdef linux}
+{$define has_sockets}
+{$endif linux}
+{$ifdef win32}
+{$define has_sockets}
+{$endif win32}
+
+{$ifdef has_sockets}
+uses crt,Sockets;
+Var
+ S : Longint ; Sin,Sout: Text;
+ Temp, Temp2 : Char;
+ i : longint;
+
+const
+ isocket: TInetSockAddr= (
+    Family:AF_INET;
+    Port:$1500;
+    Addr:((93*256+36)*256+161)*256+130);
+    {*** ftp 130.161.36.93 i.e. ftp.freepascal.org }
+    { FIXME: it would be much better to have the number
+    through a name server but I don't know how to do this ! PM }
+
+        procedure perror(const S: string);
+        begin
+        writeln(S,SocketError);
+        halt(100) ;
+        end;
+
+  procedure read_to_eof;
+    var
+      temp2 : char;
+    begin
+      repeat until not eof(sin);
+      while not eof(sin) do
+        begin
+          read(Sin,Temp2);
+          write(Temp2);
+          delay(1);
+        end;
+    end;
+
+begin
+  S:=Socket(AF_INET,SOCK_STREAM,0);
+  if SocketError<>0 then Perror('Client : Socket : ');
+  WriteLn('*1');
+  if not Connect(s,isocket,sin,sout)then Perror('Client : Socket : ');
+  WriteLn('*2');
+  ReWrite(Sout); Reset(Sin);
+  WriteLn('*3');
+  read_to_eof;
+  Writeln('Sending "USER anonymous#10"');
+  Write(Sout,'USER anonymous'#10);
+  read_to_eof;
+  Writeln('Sending "PASS [email protected]#10"');
+  Write(Sout,'PASS [email protected]'#10);
+  read_to_eof;
+  Writeln('Sending "QUIT#10"');
+  Write(Sout,'QUIT'#10);
+  read_to_eof;
+  shutdown(s,2); close(sin); close(sout);
+{$else : not has_sockets}
+  Writeln('No sockets unit for this target');
+{$endif has_sockets}
+end.