Merged revisions 6781,6787,6793-6795 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r6781 | marco | 2007-03-10 22:05:48 +0100 (Sat, 10 Mar 2007) | 1 line

 * patch for 8452 committed
........
r6787 | daniel | 2007-03-11 19:56:02 +0100 (Sun, 11 Mar 2007) | 2 lines

  + Test for append on devices.

........
r6793 | daniel | 2007-03-11 21:06:42 +0100 (Sun, 11 Mar 2007) | 2 lines

  * Force I/O checking

........
r6794 | hajny | 2007-03-11 21:57:50 +0100 (Sun, 11 Mar 2007) | 1 line

  * cleanup by Marco Borsari (borsa77)
........
r6795 | marco | 2007-03-11 22:32:32 +0100 (Sun, 11 Mar 2007) | 2 lines

 * fix for JP's problem?

........

git-svn-id: branches/fixes_2_2@7205 -

.gitattributes

@@ -6196,6 +6196,7 @@ tests/tbs/tb0527.pp svneol=native#text/plain
 tests/tbs/tb0528.pp svneol=native#text/x-pascal
 tests/tbs/tb0530.pp svneol=native#text/plain
 tests/tbs/tb0531.pp svneol=native#text/plain
+tests/tbs/tb0532.pp svneol=native#text/x-pascal
 tests/tbs/tb0533.pp svneol=native#text/plain
 tests/tbs/tb0534.pp svneol=native#text/plain
 tests/tbs/tb0535.pp svneol=native#text/plain

packages/base/winunits/buildjwa.pp

@@ -58,7 +58,7 @@ uses
     jwawpcrsmsg, jwawpftpmsg, jwawppstmsg, jwawpspihlp, jwawptypes,
     jwawpwizmsg, jwaws2atm, jwaws2bth, jwaws2dnet, jwaws2spi, jwaws2tcpip,
     jwawshisotp, jwawsnetbs, jwawsnwlink, jwawtsapi32, jwazmouse, jwasensevts,
-    jwaadstlb, jwanative, jwawindows;
+    jwaadstlb, jwanative, jwawindows, jwacarderr;
 
 implementation
 

rtl/go32v2/dos.pp

@@ -189,11 +189,9 @@ var
     ls : longint;
   begin
      paste_to_dos:=false;
-     if current_dos_buffer_pos+length(src)+3>transfer_buffer+tb_size then
-      RunError(217);
-
      ls:=Length(src)-n;
-
+     if current_dos_buffer_pos+ls+3>transfer_buffer+tb_size then
+      RunError(217);
      getmem(c,ls+3);
      move(src[n],c^,ls+1);
      if cr then
@@ -575,7 +573,7 @@ end;
 
 procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
 var
-  path0 : array[0..256] of char;
+  path0 : array[0..255] of char;
 begin
   doserror:=0;
   strpcopy(path0,path);

rtl/objpas/math.pp

@@ -519,6 +519,8 @@ function ifthen(val:boolean;const iftrue:String ; const iffalse:String ='') :Str
 
 function CompareValue ( const A, B  : Integer) : TValueRelationship; inline;
 function CompareValue ( const A, B  : Int64) : TValueRelationship; inline;
+function CompareValue ( const A, B  : QWord) : TValueRelationship; inline;
+
 {$ifdef FPC_HAS_TYPE_SINGLE}
 function CompareValue ( const A, B : Single; delta : Single = 0.0 ) : TValueRelationship; inline;
 {$endif}
@@ -2229,6 +2231,17 @@ begin
      result:=LessThanValue;
 end;
 
+function CompareValue ( const A, B : QWord) : TValueRelationship;
+
+begin
+  result:=GreaterThanValue;
+  if a=b then
+    result:=EqualsValue
+  else
+   if a<b then
+     result:=LessThanValue;
+end;
+
 {$ifdef FPC_HAS_TYPE_SINGLE}
 function CompareValue ( const A, B : Single; delta : Single = 0.0) : TValueRelationship;
 begin

tests/tbs/tb0532.pp

@@ -0,0 +1,25 @@
+program tb0532;
+
+{Append was the recommended way to open devices in TP.
+ A pitfall is that you cannot seek to the end of a device.
+
+ It has to work on modern platforms too, because:
+  - Rewrite will destroy the device on platforms where devices are
+    files.
+  - Reset doesn't allow writing to the device.
+}
+
+{$I+}
+
+var null:text;
+
+begin
+{$ifdef Unix}
+  assign(null,'/dev/null');
+{$else}
+  assign(null,'NUL');
+{$endif}
+  append(null);
+  writeln(null,'Text disappearing into the black hole.');
+  close(null);
+end.