paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-28 23:04:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* StrToBool friends, fixes #7222

Browse Source 
git-svn-id: trunk@4378 -
This commit is contained in:
florian 2006-08-06 15:38:27 +00:00
parent 705033284e
commit 215b870f5e
4 changed files with 108 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6244,6 +6244,7 @@ tests/test/units/sysutils/execansi.pp svneol=native#text/plain
tests/test/units/sysutils/execedbya.pp svneol=native#text/plain
tests/test/units/sysutils/extractquote.pp svneol=native#text/plain
tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain
tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain
tests/test/uprocext1.pp svneol=native#text/plain
tests/test/uprocext2.pp svneol=native#text/plain
tests/test/utasout.pp svneol=native#text/plain

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

@ -1345,26 +1345,14 @@ begin
Result:=Default;
end;
function StrToBool(const S: string): Boolean;
Var
Temp : String;
D : Double;
Code: word;
begin
Temp:=upcase(S);
Val(temp,D,code);
If Code=0 then
Result:=(D<>0.0)
else If Temp='TRUE' then
result:=true
else if Temp='FALSE' then
result:=false
else
if not(TryStrToBool(S,Result)) then
Raise EConvertError.CreateFmt(SInvalidBoolean,[S]);
end;
function BoolToStr(B: Boolean): string;
begin
If B then
@ -1373,6 +1361,34 @@ begin
Result:='FALSE';
end;
function StrToBoolDef(const S: string; Default: Boolean): Boolean;
begin
if not(TryStrToBool(S,Result)) then
Result:=Default;
end;
function TryStrToBool(const S: string; out Value: Boolean): Boolean;
Var
Temp : String;
D : Double;
Code: word;
begin
Temp:=upcase(S);
Val(temp,D,code);
Result:=true;
If Code=0 then
Value:=(D<>0.0)
else If Temp='TRUE' then
Value:=true
else if Temp='FALSE' then
Value:=false
else
Result:=false;
end;
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
Var

5
rtl/objpas/sysutils/sysstrh.inc
View File

@ -153,12 +153,17 @@ Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat; Preci
Function FloatToDateTime (Const Value : Extended) : TDateTime;
Function FloattoCurr (Const Value : Extended) : Currency;
function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean;
Function CurrToStr(Value: Currency): string;
function StrToCurr(const S: string): Currency;
function TryStrToCurr(const S: string;Var Value : Currency): Boolean;
function StrToCurrDef(const S: string; Default : Currency): Currency;
function StrToBool(const S: string): Boolean;
function BoolToStr(B: Boolean): string;
function StrToBoolDef(const S: string; Default: Boolean): Boolean;
function TryStrToBool(const S: string; out Value: Boolean): Boolean;
function LastDelimiter(const Delimiters, S: string): Integer;
function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;

71
tests/test/units/sysutils/tstrtobool.pp Normal file
View File

@ -0,0 +1,71 @@
uses
sysutils;
var
b : boolean;
begin
if not TryStrToBool('true',b) then
halt(1);
if not b then
halt(1);
if not TryStrToBool('false',b) then
halt(1);
if b then
halt(1);
if not TryStrToBool('True',b) then
halt(1);
if not b then
halt(1);
if not TryStrToBool('False',b) then
halt(1);
if b then
halt(1);
if not TryStrToBool('truE',b) then
halt(1);
if not b then
halt(1);
if not TryStrToBool('falsE',b) then
halt(1);
if b then
halt(1);
if not TryStrToBool('TRUE',b) then
halt(1);
if not b then
halt(1);
if not TryStrToBool('FALSE',b) then
halt(1);
if b then
halt(1);
if not TryStrToBool('3.1415',b) then
halt(1);
if not b then
halt(1);
if not TryStrToBool('0.0',b) then
halt(1);
if b then
halt(1);
if TryStrToBool('',b) then
halt(1);
if TryStrToBool('asdf',b) then
halt(1);
b:=StrToBool('truE');
if not b then
halt(1);
b:=StrToBool('falsE');
if b then
halt(1);
if not(StrToBoolDef('',true)) then
halt(1);
if StrToBoolDef('asdf',false) then
halt(1);
writeln('ok');
end.