paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-26 02:46:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix bugs 3477, 3478, 3479

Browse Source
This commit is contained in:
peter 2004-12-26 13:04:30 +00:00
parent 735a5ca27c
commit cb255fffed
1 changed files with 66 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
rtl/objpas/sysutils/sysstr.inc
View File

@ -128,7 +128,7 @@ begin
while (result=0) and (I<length) do while (result=0) and (I<length) do
begin begin
result:=byte(P1^)-byte(P2^); result:=byte(P1^)-byte(P2^);
P1:=pchar(P1)+1; // VP compat. P1:=pchar(P1)+1; // VP compat.
P2:=pchar(P2)+1; P2:=pchar(P2)+1;
i := i + 1; i := i + 1;
end ; end ;
@ -486,23 +486,23 @@ begin
if P=Q then exit; if P=Q then exit;
if P^<>quote then exit; if P^<>quote then exit;
inc(p); inc(p);
setlength(result,(Q-P)+1); setlength(result,(Q-P)+1);
R:=@Result[1]; R:=@Result[1];
i := 0; i := 0;
while P <> Q do while P <> Q do
begin begin
R^:=P^; R^:=P^;
inc(R); inc(R);
if (P^ = Quote) then if (P^ = Quote) then
begin begin
P := P + 1; P := P + 1;
if (p^ <> Quote) then if (p^ <> Quote) then
begin begin
dec(R); dec(R);
break; break;
end; end;
end; end;
P := P + 1; P := P + 1;
end ; end ;
src:=p; src:=p;
@ -788,7 +788,11 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : Longint;
Index,Width,Prec : Longint; Index,Width,Prec : Longint;
Left : Boolean; Left : Boolean;
Fchar : char; Fchar : char;
{$ifdef ver1_0}
vl : int64; vl : int64;
{$else}
vq : qword;
{$endif}
{ {
ReadFormat reads the format string. It returns the type character in ReadFormat reads the format string. It returns the type character in
@ -910,8 +914,8 @@ var Code: word;
inc(chpos); inc(chpos);
If Fmt[Chpos]='%' then If Fmt[Chpos]='%' then
begin begin
Result:='%'; Result:='%';
exit; // VP fix exit; // VP fix
end; end;
ReadIndex; ReadIndex;
ReadLeft; ReadLeft;
@ -984,11 +988,11 @@ begin
'D' : begin 'D' : begin
if Checkarg(vtinteger,false) then if Checkarg(vtinteger,false) then
Str(Args[Doarg].VInteger,ToAdd) Str(Args[Doarg].VInteger,ToAdd)
{$IFNDEF VIRTUALPASCAL} {$IFNDEF VIRTUALPASCAL}
else if CheckArg(vtInt64,true) then else if CheckArg(vtInt64,true) then
Str(Args[DoArg].VInt64^,toadd) Str(Args[DoArg].VInt64^,toadd)
{$ENDIF} {$ENDIF}
; ;
Width:=Abs(width); Width:=Abs(width);
Index:=Prec-Length(ToAdd); Index:=Prec-Length(ToAdd);
If ToAdd[1]<>'-' then If ToAdd[1]<>'-' then
@ -1000,15 +1004,15 @@ begin
'U' : begin 'U' : begin
if Checkarg(vtinteger,false) then if Checkarg(vtinteger,false) then
Str(cardinal(Args[Doarg].VInteger),ToAdd) Str(cardinal(Args[Doarg].VInteger),ToAdd)
{$IFNDEF VIRTUALPASCAL} {$IFNDEF VIRTUALPASCAL}
else if CheckArg(vtInt64,true) then else if CheckArg(vtInt64,true) then
Str(qword(Args[DoArg].VInt64^),toadd) Str(qword(Args[DoArg].VInt64^),toadd)
{$ENDIF} {$ENDIF}
; ;
Width:=Abs(width); Width:=Abs(width);
Index:=Prec-Length(ToAdd); Index:=Prec-Length(ToAdd);
ToAdd:=StringOfChar('0',Index)+ToAdd ToAdd:=StringOfChar('0',Index)+ToAdd
end; end;
'E' : begin 'E' : begin
CheckArg(vtExtended,true); CheckArg(vtExtended,true);
ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffexponent,Prec,3); ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffexponent,Prec,3);
@ -1064,38 +1068,55 @@ begin
// Insert(':',ToAdd,5); // Insert(':',ToAdd,5);
end; end;
'X' : begin 'X' : begin
{$ifdef ver1_0}
if Checkarg(vtinteger,false) then if Checkarg(vtinteger,false) then
begin begin
vl:=Args[Doarg].VInteger; vl:=Args[Doarg].VInteger and int64($ffffffff);
index:=16; index:=16;
end end
else else
begin begin
CheckArg(vtInt64,true); CheckArg(vtInt64,true);
vl:=Args[DoArg].VInt64^; vl:=Args[DoArg].VInt64^;
index:=31; index:=31;
end; end;
If Prec>index then If Prec>index then
ToAdd:=HexStr(vl,index) ToAdd:=HexStr(vl,index)
else else
begin begin
// determine minimum needed number of hex digits. // determine minimum needed number of hex digits.
Index:=1; Index:=1;
{$Ifdef ver1_0}
While (DWord(1 shl (Index*4))<=DWord(Args[DoArg].VInteger)) and (index<8) do While (DWord(1 shl (Index*4))<=DWord(Args[DoArg].VInteger)) and (index<8) do
inc(Index); inc(Index);
{$else}
While (qWord(1 shl (Index*4))<=qWord(vl)) and (index<16) do
inc(Index);
{$endif}
If Index>Prec then If Index>Prec then
Prec:=Index; Prec:=Index;
{$ifdef ver1_0}
ToAdd:=HexStr(int64(vl),Prec); ToAdd:=HexStr(int64(vl),Prec);
{$else}
ToAdd:=HexStr(qword(vl),Prec);
{$endif}
end; end;
{$else}
if Checkarg(vtinteger,false) then
begin
vq:=Cardinal(Args[Doarg].VInteger);
index:=16;
end
else
begin
CheckArg(vtInt64,true);
vq:=Qword(Args[DoArg].VInt64^);
index:=31;
end;
If Prec>index then
ToAdd:=HexStr(vq,index)
else
begin
// determine minimum needed number of hex digits.
Index:=1;
While (qWord(1) shl (Index*4)<=vq) and (index<16) do
inc(Index);
If Index>Prec then
Prec:=Index;
ToAdd:=HexStr(vq,Prec);
end;
{$endif}
end; end;
'%': ToAdd:='%'; '%': ToAdd:='%';
end; end;
@ -2186,8 +2207,8 @@ Var
C,LQ,BC : Char; C,LQ,BC : Char;
P,BLen,Len : Integer; P,BLen,Len : Integer;
HB,IBC : Boolean; HB,IBC : Boolean;
begin begin
Result:=''; Result:='';
L:=Line; L:=Line;
Blen:=Length(BreakStr); Blen:=Length(BreakStr);
@ -2211,12 +2232,12 @@ begin
LQ:=C; LQ:=C;
If (LQ<>#0) then If (LQ<>#0) then
Inc(P) Inc(P)
else else
begin begin
HB:=((C=BC) and (BreakStr=Copy(L,P,BLen))); HB:=((C=BC) and (BreakStr=Copy(L,P,BLen)));
If HB then If HB then
Inc(P,Blen-1) Inc(P,Blen)
else else
begin begin
If (P>MaxCol) then If (P>MaxCol) then
IBC:=C in BreakChars; IBC:=C in BreakChars;
@ -2237,7 +2258,7 @@ function WrapText(const Line: string; MaxCol: Integer): string;
begin begin
Result:=WrapText(Line,sLineBreak, [' ', '-', #9], MaxCol); Result:=WrapText(Line,sLineBreak, [' ', '-', #9], MaxCol);
end; end;
{ {
Case Translation Tables Case Translation Tables
@ -2299,7 +2320,10 @@ const
{ {
$Log$ $Log$
Revision 1.23 2004-12-19 17:55:38 michael Revision 1.24 2004-12-26 13:04:30 peter
* fix bugs 3477, 3478, 3479
Revision 1.23 2004/12/19 17:55:38 michael
+ Implemented wraptext + Implemented wraptext
Revision 1.22 2004/12/01 10:34:46 michael Revision 1.22 2004/12/01 10:34:46 michael