paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-01 22:29:58 +01:00
Code Issues Packages Projects Releases Wiki Activity

* enhanced xml schema datatype parsers (booltostr is twice as fast)

Browse Source 
git-svn-id: trunk@14112 -
This commit is contained in:
ivost 2009-11-08 12:38:44 +00:00
parent 27114853b4
commit b9eb513791
1 changed files with 136 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

260
packages/libxml/src/xmlxsd.pas
View File

@ -70,9 +70,9 @@ function xsdFormatUnsignedLong(Value: QWord): String;
function xsdFormatEnum(enum: array of String; Value: Integer): String; function xsdFormatEnum(enum: array of String; Value: Integer): String;
{ DateTime functions } { DateTime functions }
procedure xsdTimeConvertTo(var Hour, Minute, Second, Milliseconds: Longword; var Source: TTimezone; const Target: TTimezone); procedure xsdTimeConvertTo(var Hour, Minute, Second, Milliseconds: Longword; const Current, Target: TTimezone);
procedure xsdDateConvertTo(var Year, Month, Day: Longword; var Source: TTimezone; const Target: TTimezone); procedure xsdDateConvertTo(var Year, Month, Day: Longword; const Current, Target: TTimezone);
procedure xsdDateTimeConvertTo(var Year, Month, Day, Hour, Minute, Second, Milliseconds: Longword; var Source: TTimezone; const Target: TTimezone); procedure xsdDateTimeConvertTo(var Year, Month, Day, Hour, Minute, Second, Milliseconds: Longword; const Current, Target: TTimezone);
{ Parse functions } { Parse functions }
function xsdTryParseString(Chars, Last: xmlCharPtr; out Value: String): Boolean; function xsdTryParseString(Chars, Last: xmlCharPtr; out Value: String): Boolean;
@ -484,17 +484,17 @@ begin
Result := enum[Value]; Result := enum[Value];
end; end;
procedure xsdTimeConvertTo(var Hour, Minute, Second, Milliseconds: Longword; var Source: TTimezone; const Target: TTimezone); procedure xsdTimeConvertTo(var Hour, Minute, Second, Milliseconds: Longword; const Current, Target: TTimezone);
begin begin
{$warning not implemented} {$warning not implemented}
end; end;
procedure xsdDateConvertTo(var Year, Month, Day: Longword; var Source: TTimezone; const Target: TTimezone); procedure xsdDateConvertTo(var Year, Month, Day: Longword; const Current, Target: TTimezone);
begin begin
{$warning not implemented} {$warning not implemented}
end; end;
procedure xsdDateTimeConvertTo(var Year, Month, Day, Hour, Minute, Second, Milliseconds: Longword; var Source: TTimezone; const Target: TTimezone); procedure xsdDateTimeConvertTo(var Year, Month, Day, Hour, Minute, Second, Milliseconds: Longword; const Current, Target: TTimezone);
begin begin
{$warning not implemented} {$warning not implemented}
end; end;
@ -503,20 +503,23 @@ function xsdTryParseString(Chars, Last: xmlCharPtr; out Value: String): Boolean;
var var
Len: Integer; Len: Integer;
begin begin
if Assigned(Last) then if Assigned(Chars) then
begin if Assigned(Last) then
Len := Last-Chars;
if Len > 0 then
begin begin
SetLength(Value, Len); Len := Last-Chars+1;
Move(Chars^, Value[1], Len); if Len > 0 then
begin
SetLength(Value, Len);
Move(Chars^, Value[1], Len);
Result := True;
end else
Result := False;
end else begin
Value := PChar(Chars);
Result := True; Result := True;
end else end
Result := False; else
end else begin Result := False;
Value := PChar(Chars);
Result := Assigned(Chars);
end;
end; end;
function __strpas(Chars, Last: xmlCharPtr): String; function __strpas(Chars, Last: xmlCharPtr): String;
@ -527,40 +530,47 @@ end;
function xsdTryParseBoolean(Chars, Last: xmlCharPtr; out Value: Boolean): Boolean; function xsdTryParseBoolean(Chars, Last: xmlCharPtr; out Value: Boolean): Boolean;
var var
P,L: PChar; P: PChar;
L: PChar absolute Last;
function __char(C: Char): Boolean; inline; Num: QWord;
Len: Integer;
begin
if not Assigned(Last) then
begin begin
Result := (P <= L) and (UpperCase(P^) = C); P := PChar(Chars);
if Result then Inc(P); Len := 0;
while (Len < 7) and (P^ <> #0) do
begin
Inc(Len);
Inc(P);
end;
end else
Len := Last-Chars+1;
case Len of
1: Num := PByte(Chars)^;
4: Num := PLongword(Chars)^;
5: Num := PLongword(Chars)^ or (QWord(Chars[4]) shl 32);
else Exit(False);
end; end;
begin //writeln(Len, ', ', IntToHex(Num,16));
P := PChar(Chars);
if Assigned(Last) then
L := PChar(Last)
else
L := IGNORE_LAST;
if Assigned(P) then case Num of
begin $30,
if (P <= L) and (P^ = '1') and (((L = IGNORE_LAST) and (P[1] = #0)) or (P = L)) then $65736C6166,$65736C6146,$65736C4166,$65736C4146,$65734C6166,$65734C6146,$65734C4166,$65734C4146,
Value := True $65536C6166,$65536C6146,$65536C4166,$65536C4146,$65534C6166,$65534C6146,$65534C4166,$65534C4146,
else $45736C6166,$45736C6146,$45736C4166,$45736C4146,$45734C6166,$45734C6146,$45734C4166,$45734C4146,
if (P <= L) and (P^ = '0') and (((L = IGNORE_LAST) and (P[1] = #0)) or (P = L)) then $45536C6166,$45536C6146,$45536C4166,$45536C4146,$45534C6166,$45534C6146,$45534C4166,$45534C4146:
Value := False Value := False;
else $31,
if __char('T') and __char('R') and __char('U') and __char('E') and (((L = IGNORE_LAST) and (P^ = #0)) or (P = L+1)) then $65757274,$65757254,$65755274,$65755254,$65557274,$65557254,$65555274,$65555254,
Value := True $45757274,$45757254,$45755274,$45755254,$45557274,$45557254,$45555274,$45555254:
else begin Value := True;
P := PChar(Chars); else Exit(False);
if __char('F') and __char('A') and __char('L') and __char('S') and __char('E') and (((L = IGNORE_LAST) and (P^ = #0)) or (P = L+1)) then end;
Value := False
else Result := True;
Result := False;
end;
end else
Result := False;
end; end;
function __parseTimezone(var P: PChar; const L: PChar; out T: TTimezone): Boolean; function __parseTimezone(var P: PChar; const L: PChar; out T: TTimezone): Boolean;
@ -583,7 +593,7 @@ begin
N := P^ = '-'; N := P^ = '-';
Inc(P); Inc(P);
{ expect 00..13 } { expect 00..13 }
T.Hour := 0; I := 2; T.Hour := 0; I := 2;
while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do
begin begin
@ -595,12 +605,12 @@ begin
if N then if N then
T.Hour := -T.Hour; T.Hour := -T.Hour;
{ expect ':' } { expect ':' }
if (P > L) or (P^ <> ':') then if (P > L) or (P^ <> ':') then
Exit(False); Exit(False);
Inc(P); Inc(P);
{ expect 00..59 } { expect 00..59 }
T.Minute := 0; I := 2; T.Minute := 0; I := 2;
while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do
begin begin
@ -625,7 +635,7 @@ function __parseDate(var P: PChar; const L: PChar; out Year, Month, Day: Longwor
var var
I: Integer; I: Integer;
begin begin
{ allow '-' } { allow '-' }
if (P <= L) and (P^ = '-') then if (P <= L) and (P^ = '-') then
begin begin
if Assigned(BC) then if Assigned(BC) then
@ -637,7 +647,7 @@ begin
if Assigned(BC) then if Assigned(BC) then
BC^ := False; BC^ := False;
{ expect Integer } { expect Integer }
Year := 0; Year := 0;
while (P <= L) and (P^ in ['0'..'9']) do while (P <= L) and (P^ in ['0'..'9']) do
begin begin
@ -645,12 +655,12 @@ begin
Inc(P); Inc(P);
end; end;
{ expect '-' } { expect '-' }
if (P > L) or (P^ <> '-') then if (P > L) or (P^ <> '-') then
Exit(False); Exit(False);
Inc(P); Inc(P);
{ expect 01..12 } { expect 01..12 }
Month := 0; I := 2; Month := 0; I := 2;
while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do
begin begin
@ -660,12 +670,12 @@ begin
if (Month < 1) or (Month > 12) then if (Month < 1) or (Month > 12) then
Exit(False); Exit(False);
{ expect '-' } { expect '-' }
if (P > L) or (P^ <> '-') then if (P > L) or (P^ <> '-') then
Exit(False); Exit(False);
Inc(P); Inc(P);
{ expect 01..31 } { expect 01..31 }
Day := 0; I := 2; Day := 0; I := 2;
while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do
begin begin
@ -682,7 +692,7 @@ function __parseTime(var P: PChar; const L: PChar; out Hour, Minute, Second, Mil
var var
I: Integer; I: Integer;
begin begin
{ expect 00..24 } { expect 00..24 }
Hour := 0; I := 2; Hour := 0; I := 2;
while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do
begin begin
@ -692,12 +702,12 @@ begin
if Hour > 24 then if Hour > 24 then
Exit(False); Exit(False);
{ expect ':' } { expect ':' }
if (P > L) or (P^ <> ':') then if (P > L) or (P^ <> ':') then
Exit(False); Exit(False);
Inc(P); Inc(P);
{ expect 00..59 } { expect 00..59 }
Minute := 0; I := 2; Minute := 0; I := 2;
while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do
begin begin
@ -707,12 +717,12 @@ begin
if (Minute > 59) or ((Hour = 24) and (Minute > 0)) then if (Minute > 59) or ((Hour = 24) and (Minute > 0)) then
Exit(False); Exit(False);
{ expect ':' } { expect ':' }
if (P > L) or (P^ <> ':') then if (P > L) or (P^ <> ':') then
Exit(False); Exit(False);
Inc(P); Inc(P);
{ expect 00..59 } { expect 00..59 }
Second := 0; I := 2; Second := 0; I := 2;
while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do while (P <= L) and (P^ in ['0'..'9']) and (I > 0) do
begin begin
@ -722,7 +732,7 @@ begin
if (Second > 59) or ((Hour = 24) and (Second > 0)) then if (Second > 59) or ((Hour = 24) and (Second > 0)) then
Exit(False); Exit(False);
{ allow '.' } { allow '.' }
if (P <= L) and (P^ = '.') then if (P <= L) and (P^ = '.') then
begin begin
Inc(P); Inc(P);
@ -744,22 +754,21 @@ end;
function xsdTryParseDate(Chars, Last: xmlCharPtr; out Year, Month, Day: Longword; Timezone: PTimezone; BC: PBoolean): Boolean; function xsdTryParseDate(Chars, Last: xmlCharPtr; out Year, Month, Day: Longword; Timezone: PTimezone; BC: PBoolean): Boolean;
var var
P,L: PChar; P: PChar;
L: PChar absolute Last;
T: TTimezone; T: TTimezone;
begin begin
P := PChar(Chars); P := PChar(Chars);
if Assigned(Last) then if Assigned(Last) then
L := PChar(Last) Result := Assigned(P) and
__parseDate(P, L, Year, Month, Day, BC) and
__parseTimezone(P, L, T) and (P = L+1)
else else
L := IGNORE_LAST; Result := Assigned(P) and
__parseDate(P, IGNORE_LAST, Year, Month, Day, BC) and
__parseTimezone(P, IGNORE_LAST, T) and (P^ = #0);
Result := { assign Timezone if requested }
Assigned(P) and
__parseDate(P, L, Year, Month, Day, BC) and
__parseTimezone(P, L, T) and
((L = IGNORE_LAST) and (P^ = #0)) or (P = L+1);
{ assign Timezone if requested }
if Result and Assigned(Timezone) then if Result and Assigned(Timezone) then
begin begin
if Timezone^.Convert then if Timezone^.Convert then
@ -781,22 +790,21 @@ end;
function xsdTryParseTime(Chars, Last: xmlCharPtr; out Hour, Minute, Second, Milliseconds: Longword; Timezone: PTimezone): Boolean; function xsdTryParseTime(Chars, Last: xmlCharPtr; out Hour, Minute, Second, Milliseconds: Longword; Timezone: PTimezone): Boolean;
var var
P,L: PChar; P: PChar;
L: PChar absolute Last;
T: TTimezone; T: TTimezone;
begin begin
P := PChar(Chars); P := PChar(Chars);
if Assigned(Last) then if Assigned(Last) then
L := PChar(Last) Result := Assigned(P) and
__parseTime(P, L, Hour, Minute, Second, Milliseconds) and
__parseTimezone(P, L, T) and (P = L+1)
else else
L := IGNORE_LAST; Result := Assigned(P) and
__parseTime(P, IGNORE_LAST, Hour, Minute, Second, Milliseconds) and
__parseTimezone(P, IGNORE_LAST, T) and (P^ = #0);
Result := { assign Timezone if requested }
Assigned(P) and
__parseTime(P, L, Hour, Minute, Second, Milliseconds) and
__parseTimezone(P, L, T) and
((L = IGNORE_LAST) and (P^ = #0)) or (P = L+1);
{ assign Timezone if requested }
if Result and Assigned(Timezone) then if Result and Assigned(Timezone) then
begin begin
if Timezone^.Convert then if Timezone^.Convert then
@ -825,24 +833,25 @@ function xsdTryParseDateTime(Chars, Last: xmlCharPtr; out Year, Month, Day, Hour
end; end;
var var
P,L: PChar; P: PChar;
L: PChar absolute Last;
T: TTimezone; T: TTimezone;
begin begin
P := PChar(Chars); P := PChar(Chars);
if Assigned(Last) then if Assigned(Last) then
L := PChar(Last) Result := Assigned(P) and
__parseDate(P, L, Year, Month, Day, BC) and
__parseT(P, L) and
__parseTime(P, L, Hour, Minute, Second, Milliseconds) and
__parseTimezone(P, L, T) and (P = L+1)
else else
L := IGNORE_LAST; Result := Assigned(P) and
__parseDate(P, IGNORE_LAST, Year, Month, Day, BC) and
__parseT(P, IGNORE_LAST) and
__parseTime(P, IGNORE_LAST, Hour, Minute, Second, Milliseconds) and
__parseTimezone(P, IGNORE_LAST, T) and (P^ = #0);
Result := { assign Timezone if requested }
Assigned(P) and
__parseDate(P, L, Year, Month, Day, BC) and
__parseT(P, L) and
__parseTime(P, L, Hour, Minute, Second, Milliseconds) and
__parseTimezone(P, L, T) and
((L = IGNORE_LAST) and (P^ = #0)) or (P = L+1);
{ assign Timezone if requested }
if Result and Assigned(Timezone) then if Result and Assigned(Timezone) then
begin begin
if Timezone^.Convert then if Timezone^.Convert then
@ -865,41 +874,32 @@ end;
function xsdTryParseDecimal(Chars, Last: xmlCharPtr; out Value: Extended): Boolean; function xsdTryParseDecimal(Chars, Last: xmlCharPtr; out Value: Extended): Boolean;
begin begin
Result := Assigned(Chars) and TryStrToFloat(PChar(Chars), Value); Result := Assigned(Chars) and TryStrToFloat(__strpas(Chars, Last), Value);
{$warning last param not checked!} {$warning slow parser!}
end; end;
function xsdTryParseDouble(Chars, Last: xmlCharPtr; out Value: Double): Boolean; function xsdTryParseDouble(Chars, Last: xmlCharPtr; out Value: Double): Boolean;
begin begin
Result := Assigned(Chars) and TryStrToFloat(PChar(Chars), Value); Result := Assigned(Chars) and TryStrToFloat(__strpas(Chars, Last), Value);
end; end;
function xsdTryParseFloat(Chars, Last: xmlCharPtr; out Value: Single): Boolean; function xsdTryParseFloat(Chars, Last: xmlCharPtr; out Value: Single): Boolean;
begin begin
Result := Assigned(Chars) and TryStrToFloat(PChar(Chars), Value); Result := Assigned(Chars) and TryStrToFloat(__strpas(Chars, Last), Value);
end; end;
function xsdTryParseInteger(Chars, Last: xmlCharPtr; out Value: Int64): Boolean; function __parseInteger(var P: PChar; const L: PChar; out Value: Int64): Boolean;
var var
P,L: PChar;
N: Boolean; N: Boolean;
begin begin
P := PChar(Chars); Value := 0;
if Assigned(Last) then
L := PChar(Last)
else
L := IGNORE_LAST;
if not Assigned(P) then { allow '-' }
Exit(False);
{ allow '-' }
N := (P <= L) and (P^ = '-'); N := (P <= L) and (P^ = '-');
if N then if N then
Inc(P); Inc(P);
{ read Integer } { read Integer }
Value := 0;
while (P <= L) and (P^ in ['0'..'9']) do while (P <= L) and (P^ in ['0'..'9']) do
begin begin
Value := 10*Value + Ord(P^) - Ord('0'); Value := 10*Value + Ord(P^) - Ord('0');
@ -908,33 +908,45 @@ begin
if N then if N then
Value := -Value; Value := -Value;
{ expect #0 } Result := True;
Result := ((L = IGNORE_LAST) and (P^ = #0)) or (P = L+1);
end; end;
function xsdTryParseNonNegativeInteger(Chars, Last: xmlCharPtr; out Value: QWord): Boolean; function xsdTryParseInteger(Chars, Last: xmlCharPtr; out Value: Int64): Boolean;
var var
P,L: PChar; P: PChar;
L: PChar absolute Last;
begin begin
P := PChar(Chars); P := PChar(Chars);
if Assigned(Last) then if Assigned(Last) then
L := PChar(Last) Result := Assigned(P) and __parseInteger(P, L, Value) and (P = L+1)
else else
L := IGNORE_LAST; Result := Assigned(P) and __parseInteger(P, IGNORE_LAST, Value) and (P^ = #0);
end;
if not Assigned(P) then function __parseNonNegativeInteger(var P: PChar; const L: PChar; out Value: QWord): Boolean;
Exit(False); begin
{ read Integer }
Value := 0; Value := 0;
{ read Integer }
while (P <= L) and (P^ in ['0'..'9']) do while (P <= L) and (P^ in ['0'..'9']) do
begin begin
Value := 10*Value + Ord(P^) - Ord('0'); Value := 10*Value + Ord(P^) - Ord('0');
Inc(P); Inc(P);
end; end;
{ expect #0 } Result := True;
Result := ((L = IGNORE_LAST) and (P^ = #0)) or (P = L+1); end;
function xsdTryParseNonNegativeInteger(Chars, Last: xmlCharPtr; out Value: QWord): Boolean;
var
P: PChar;
L: PChar absolute Last;
begin
P := PChar(Chars);
if Assigned(Last) then
Result := Assigned(P) and __parseNonNegativeInteger(P, L, Value) and (P = L+1)
else
Result := Assigned(P) and __parseNonNegativeInteger(P, IGNORE_LAST, Value) and (P^ = #0);
end; end;
function xsdTryParseNonPositiveInteger(Chars, Last: xmlCharPtr; out Value: Int64): Boolean; function xsdTryParseNonPositiveInteger(Chars, Last: xmlCharPtr; out Value: Int64): Boolean;