paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 03:29:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fcl-xml, upgrade to comply with XML 1.0 Fifth Edition. This makes naming rules for xml 1.0 identical to ones for xml 1.1.

Browse Source 
git-svn-id: trunk@20422 -
This commit is contained in:
sergei 2012-02-24 06:25:32 +00:00
parent e5692558b9
commit 6adf381867
5 changed files with 81 additions and 288 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
packages/fcl-xml/src/dom.pp
View File

@ -2019,11 +2019,11 @@ end;
{ if nsIdx = -1, checks only the name. Otherwise additionally checks if the prefix is { if nsIdx = -1, checks only the name. Otherwise additionally checks if the prefix is
valid for standard namespace specified by nsIdx. valid for standard namespace specified by nsIdx.
Non-negative return value is Pos(':', QName), negative is DOM error code. } Non-negative return value is Pos(':', QName), negative is DOM error code. }
function CheckQName(const QName: DOMString; nsIdx: Integer; Xml11: Boolean): Integer; function CheckQName(const QName: DOMString; nsIdx: Integer): Integer;
var var
I, L: Integer; I, L: Integer;
begin begin
if not IsXmlName(QName, Xml11) then if not IsXmlName(QName) then
begin begin
Result := -INVALID_CHARACTER_ERR; Result := -INVALID_CHARACTER_ERR;
Exit; Exit;
@ -2041,7 +2041,7 @@ begin
end; end;
// Name validity has already been checked by IsXmlName() call above. // Name validity has already been checked by IsXmlName() call above.
// So just check that colon isn't first or last char, and that it is follwed by NameStartChar. // So just check that colon isn't first or last char, and that it is follwed by NameStartChar.
if ((Result = 1) or (Result = L) or not IsXmlName(@QName[Result+1], 1, Xml11)) then if ((Result = 1) or (Result = L) or not IsXmlName(@QName[Result+1], 1)) then
begin begin
Result := -NAMESPACE_ERR; Result := -NAMESPACE_ERR;
Exit; Exit;
@ -2074,7 +2074,7 @@ var
res: Integer; res: Integer;
model: TDTDModel; model: TDTDModel;
begin begin
res := CheckQName(QualifiedName, -1, False); res := CheckQName(QualifiedName, -1);
if res < 0 then if res < 0 then
raise EDOMError.Create(-res, 'Implementation.CreateDocumentType'); raise EDOMError.Create(-res, 'Implementation.CreateDocumentType');
model := TDTDModel.Create(nil); // !!nowhere to get nametable from at this time model := TDTDModel.Create(nil); // !!nowhere to get nametable from at this time
@ -2280,7 +2280,7 @@ end;
function TDOMDocument.CreateElement(const tagName: DOMString): TDOMElement; function TDOMDocument.CreateElement(const tagName: DOMString): TDOMElement;
begin begin
if not IsXmlName(tagName, FXMLVersion = xmlVersion11) then if not IsXmlName(tagName) then
raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateElement'); raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateElement');
TDOMNode(Result) := Alloc(TDOMElement); TDOMNode(Result) := Alloc(TDOMElement);
Result.Create(Self); Result.Create(Self);
@ -2348,7 +2348,7 @@ end;
function TDOMDocument.CreateAttribute(const name: DOMString): TDOMAttr; function TDOMDocument.CreateAttribute(const name: DOMString): TDOMAttr;
begin begin
if not IsXmlName(name, FXMLVersion = xmlVersion11) then if not IsXmlName(name) then
raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateAttribute'); raise EDOMError.Create(INVALID_CHARACTER_ERR, 'DOMDocument.CreateAttribute');
TDOMNode(Result) := Alloc(TDOMAttr); TDOMNode(Result) := Alloc(TDOMAttr);
Result.Create(Self); Result.Create(Self);
@ -2450,7 +2450,7 @@ var
idx, PrefIdx: Integer; idx, PrefIdx: Integer;
begin begin
idx := IndexOfNS(nsURI, True); idx := IndexOfNS(nsURI, True);
PrefIdx := CheckQName(QualifiedName, idx, FXMLVersion = xmlVersion11); PrefIdx := CheckQName(QualifiedName, idx);
if PrefIdx < 0 then if PrefIdx < 0 then
raise EDOMError.Create(-PrefIdx, 'Document.CreateAttributeNS'); raise EDOMError.Create(-PrefIdx, 'Document.CreateAttributeNS');
TDOMNode(Result) := Alloc(TDOMAttr); TDOMNode(Result) := Alloc(TDOMAttr);
@ -2468,7 +2468,7 @@ var
idx, PrefIdx: Integer; idx, PrefIdx: Integer;
begin begin
idx := IndexOfNS(nsURI, True); idx := IndexOfNS(nsURI, True);
PrefIdx := CheckQName(QualifiedName, idx, FXMLVersion = xmlVersion11); PrefIdx := CheckQName(QualifiedName, idx);
if PrefIdx < 0 then if PrefIdx < 0 then
raise EDOMError.Create(-PrefIdx, 'Document.CreateElementNS'); raise EDOMError.Create(-PrefIdx, 'Document.CreateElementNS');
TDOMNode(Result) := Alloc(TDOMElement); TDOMNode(Result) := Alloc(TDOMElement);
@ -2541,7 +2541,7 @@ end;
function TXMLDocument.CreateProcessingInstruction(const target, function TXMLDocument.CreateProcessingInstruction(const target,
data: DOMString): TDOMProcessingInstruction; data: DOMString): TDOMProcessingInstruction;
begin begin
if not IsXmlName(target, FXMLVersion = xmlVersion11) then if not IsXmlName(target) then
raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateProcessingInstruction'); raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateProcessingInstruction');
TDOMNode(Result) := Alloc(TDOMProcessingInstruction); TDOMNode(Result) := Alloc(TDOMProcessingInstruction);
Result.Create(Self); Result.Create(Self);
@ -2555,7 +2555,7 @@ var
dType: TDOMDocumentType; dType: TDOMDocumentType;
ent: TDOMEntity; ent: TDOMEntity;
begin begin
if not IsXmlName(name, FXMLVersion = xmlVersion11) then if not IsXmlName(name) then
raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateEntityReference'); raise EDOMError.Create(INVALID_CHARACTER_ERR, 'XMLDocument.CreateEntityReference');
TDOMNode(Result) := Alloc(TDOMEntityReference); TDOMNode(Result) := Alloc(TDOMEntityReference);
Result.Create(Self); Result.Create(Self);
@ -2624,7 +2624,7 @@ var
NewName: DOMString; NewName: DOMString;
begin begin
Changing; Changing;
if not IsXmlName(Value, FOwnerDocument.FXMLVersion = xmlVersion11) then if not IsXmlName(Value) then
raise EDOMError.Create(INVALID_CHARACTER_ERR, 'Node.SetPrefix'); raise EDOMError.Create(INVALID_CHARACTER_ERR, 'Node.SetPrefix');
if (Pos(WideChar(':'), Value) > 0) or not (nfLevel2 in FFlags) or if (Pos(WideChar(':'), Value) > 0) or not (nfLevel2 in FFlags) or
@ -2979,7 +2979,7 @@ var
begin begin
Changing; Changing;
idx := FOwnerDocument.IndexOfNS(nsURI, True); idx := FOwnerDocument.IndexOfNS(nsURI, True);
prefIdx := CheckQName(qualifiedName, idx, FOwnerDocument.FXMLVersion = xmlVersion11); prefIdx := CheckQName(qualifiedName, idx);
if prefIdx < 0 then if prefIdx < 0 then
raise EDOMError.Create(-prefIdx, 'Element.SetAttributeNS'); raise EDOMError.Create(-prefIdx, 'Element.SetAttributeNS');

215
packages/fcl-xml/src/names.inc
View File

@ -18,171 +18,42 @@ type
const const
// colon ($3a) is excluded, it is handled in the code // colon ($3a) is excluded, it is handled in the code
ns_ASCII = [{ $3A,} $41..$5A, $5F, $61..$7A, $C0..$D6, $D8..$F6, $F8..$FF]; ns_ASCII = [{ $3A,} $41..$5A, $5F, $61..$7A, $C0..$D6, $D8..$F6, $F8..$FF];
ns_0200 = [0..$17, $50..$A8, $BB..$C1];
ns_0300 = [$86, $88..$8A, $8C, $8E..$A1,
$A3..$CE, $D0..$D6, $DA, $DC,
$DE, $E0, $E2..$F3];
ns_0400 = [$01..$0C, $0E..$4F, $51..$5C,
$5E..$81, $90..$C4, $C7..$C8,
$CB..$CC, $D0..$EB, $EE..$F5,
$F8..$F9];
ns_0500 = [$31..$56, $59, $61..$86, $D0..$EA, $F0..$F2];
ns_0600 = [$21..$3A, $41..$4A, $71..$B7,
$BA..$BE, $C0..$CE, $D0..$D3,
$D5, $E5..$E6];
ns_0900 = [$05..$39, $3D, $58..$61,
$85..$8C, $8F..$90, $93..$A8,
$AA..$B0, $B2, $B6..$B9,
$DC..$DD, $DF..$E1, $F0..$F1];
ns_0A00 = [$05..$0A, $0F..$10, $13..$28,
$2A..$30, $32..$33, $35..$36,
$38..$39, $59..$5C, $5E, $72..$74,
$85..$8B, $8D, $8F..$91, $93..$A8,
$AA..$B0, $B2..$B3, $B5..$B9, $BD, $E0];
ns_0B00 = [$05..$0C, $0F..$10, $13..$28,
$2A..$30, $32..$33, $36..$39,
$3D, $5C..$5D, $5F..$61, $85..$8A,
$8E..$90, $92..$95, $99..$9A,
$9C, $9E..$9F, $A3..$A4, $A8..$AA,
$AE..$B5, $B7..$B9];
ns_0C00 = [$05..$0C, $0E..$10, $12..$28,
$2A..$33, $35..$39, $60..$61,
$85..$8C, $8E..$90, $92..$A8,
$AA..$B3, $B5..$B9, $DE, $E0..$E1];
ns_0D00 = [$05..$0C, $0E..$10, $12..$28, $2A..$39, $60..$61];
ns_0E00 = [$01..$2E, $30, $32..$33, $40..$45,
$81..$82, $84, $87..$88, $8A, $8D,
$94..$97, $99..$9F, $A1..$A3,
$A5, $A7, $AA..$AB, $AD..$AE,
$B0, $B2..$B3, $BD, $C0..$C4];
ns_0F00 = [$40..$47, $49..$69];
ns_3000 = [$41..$94, $A1..$FA] + [$07, $21..$29]; namingBitmap: array[0..$0C] of TSetOfByte = (
namingBitmap: array[0..$30] of TSetOfByte = (
[], // 00 - nothing allowed [], // 00 - nothing allowed
[0..255], // 01 - all allowed [0..255], // 01 - all allowed
ns_ASCII, // 02 ns_ASCII, // 02
[0..$31, $34..$3E, $41..$48, // 03 - $0100, both Name and NameStart
$4A..$7E, $80..$C3, $CD..$F0,
$F4..$F5, $FA..$FF],
ns_0200, // 04 ns_ASCII + // 03 - $0000, Names
ns_0300, // 05
ns_0400, // 06
ns_0500, // 07
ns_0600, // 08
ns_0900, // 09
ns_0A00, // 0A
ns_0B00, // 0B
ns_0C00, // 0C
ns_0D00, // 0D
ns_0E00, // 0E
ns_0F00, // 0F
[$A0..$C5, $D0..$F6], // 10 - $1000, both Name and NameStart
[0, $02..03, $05..$07, $09, // 11 - $1100, both Name and NameStart
$0B..$0C, $0E..$12, $3C, $3E,
$40, $4C, $4E, $50, $54..$55,
$59, $5F..$61, $63, $65, $67,
$69, $6D..$6E, $72..$73, $75,
$9E, $A8, $AB, $AE..$AF,
$B7..$B8, $BA, $BC..$C2, $EB, $F0, $F9],
[0..$9B, $A0..$F9], // 12 - $1E00, both Name and NameStart
[0..$15, $18..$1D, $20..$45, // 13 - $1F00, both Name and NameStart
$48..$4D, $50..$57, $59, $5B, $5D,
$5F..$7D, $80..$B4, $B6..$BC, $BE,
$C2..$C4, $C6..$CC, $D0..$D3,
$D6..$DB, $E0..$EC, $F2..$F4, $F6..$FC],
[$26, $2A..$2B, $2E, $80..$82], // 14 - $2100, NameStart
ns_3000, // 15
[$05..$2C], // 16 - $3100, NameStart
[0..$A5], // 17 - $9F00, NameStart (ideographs)
[0..$A3], // 18 - $D700, NameStart
ns_ASCII + // 19 - $0000, Names
[$2D..$2E, $30..$39, $B7], [$2D..$2E, $30..$39, $B7],
ns_0200 + // 1A - $0200, Names
[$D0..$D1],
ns_0300 + // 1B - $0300, Names
[0..$45, $60..$61, $87],
ns_0400 + // 1C - $0400, Names
[$83..$86],
ns_0500 + // 1D - $0500, Names
[$91..$A1, $A3..$B9, $BB..$BD, { combining }
$BF, $C1..$C2, $C4],
ns_0600 + // 1E - $0600, Names
[$4B..$52, $70, $D6..$DC, $DD..$DF, { combining }
$E0..$E4, $E7..$E8, $EA..$ED] +
[$60..$69, $F0..$F9] + [$40], { digits + ext }
ns_0900 + // 1F - $0900, Names
[$01..$03, $3C, $3E..$4C, $4D, { combining }
$51..$54, $62..$63, $81..$83,
$BC, $BE, $BF, $C0..$C4, $C7..$C8,
$CB..$CD, $D7, $E2..$E3] +
[$66..$6F, $E6..$EF], { digits }
ns_0A00 + // 20 - $0A00, Names
[$02, $3C, $3E..$42, $47..$48, $4B..$4D, { combining }
$70..$71, $81..$83, $BC, $BE..$C5,
$C7..$C9, $CB..$CD] +
[$66..$6F, $E6..$EF], { digits }
ns_0B00 + // 21 - $0B00, Names
[$01..$03, $3C, $3E..$43, $47..$48, { combining }
$4B..$4D, $56..$57, $82..$83, $BE..$C2,
$C6..$C8, $CA..$CD, $D7] +
[$66..$6F, $E7..$EF], { digits }
ns_0C00 + // 22 - $0C00, Names
[$01..$03, $3E..$44, $46..$48, { combining }
$4A..$4D, $55..$56, $82..$83,
$BE..$C4, $C6..$C8, $CA..$CD, $D5..$D6] +
[$66..$6F, $E6..$EF], { digits }
ns_0D00 + // 23 - $0D00, Names
[$02..$03, $3E..$43, { combining }
$46..$48, $4A..$4D, $57] +
[$66..$6F], { digits }
ns_0E00 + // 24 - $0E00, Names
[$31, $34..$3A, $47..$4E, { combining }
$B1, $B4..$B9, $BB..$BC,
$C8..$CD] +
[$50..$59, $D0..$D9] + { digits }
[$46, $C6], { extenders }
ns_0F00 + // 25 - $0F00, Names
[$18..$19, $35, $37, $39, { combining }
$3E, $3F, $71..$84, $86..$8B,
$90..$95, $97, $99..$AD,
$B1..$B7, $B9] +
[$20..$29], { digits }
[$D0..$DC, $E1], // 26 - $2000, Names (combining)
ns_3000 + // 27 - $3000, Names
[$2A..$2F, $99, $9A] + { combining }
[$05, $31..$35, $9D..$9E, $FC..$FE], { extenders }
{ XML 1.1 additions } [0..$CF, $F0..$FF], // 04 $FD00 - NameStart
[0..$EF], // 05 $2F00 - NameStart
[0..$CF, $F0..$FF], // 28 $FD00 - NameStart [$0C..$0D, $70..$FF], // 06 $2000 - NameStart
[0..$EF], // 29 $2F00 - NameStart [0..$8F], // 07 $2100 - NameStart
[$0C..$0D, $70..$FF], // 2A $2000 - NameStart [$70..$7D, $7F..$FF], // 08 $0300 - NameStart
[0..$8F], // 2B $2100 - NameStart [1..$FF], // 09 $3000 - NameStart
[$70..$7D, $7F..$FF], // 2C $0300 - NameStart [0..$7D, $7F..$FF], // 0A $0300 - Names
[1..$FF], // 2D $3000 - NameStart [$0C..$0D, $3F..$40, $70..$FF], // 0B $2000 - Names
[0..$7D, $7F..$FF], // 2E $0300 - Names [$00..$FD] // 0C $FF00 - both Name and NameStart
[$0C..$0D, $3F..$40, $70..$FF], // 2F $2000 - Names
[$00..$FD] // 30 $FF00 - both Name and NameStart
); );
Xml11HighPages: TSetOfByte = [0..$21, $2C..$D7, $F9..$FE];
NamePages: array[0..511] of Byte = ( NamePages: array[0..511] of Byte = (
$02, $03, $04, $05, $06, $07, $08, $00, $02, $01, $01, $08, $01, $01, $01, $01,
$00, $09, $0A, $0B, $0C, $0D, $0E, $0F, $01, $01, $01, $01, $01, $01, $01, $01,
$10, $11, $00, $00, $00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01, $01,
$00, $00, $00, $00, $00, $00, $12, $13, $01, $01, $01, $01, $01, $01, $01, $01,
$00, $14, $00, $00, $00, $00, $00, $00, $06, $07, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $01, $01, $05,
$15, $16, $00, $00, $00, $00, $00, $00, $09, $01, $01, $01, $01, $01, $01, $01,
$00, $00, $00, $00, $00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01, $01,
$00, $00, $00, $00, $00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01, $01,
$00, $00, $00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
@ -192,30 +63,30 @@ $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $17,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $18,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $01, $01, $01, $01, $04, $01, $0C,
// second half - NameChars // second half - NameChars
$19, $03, $1A, $1B, $1C, $1D, $1E, $00, $03, $01, $01, $0A, $01, $01, $01, $01,
$00, $1F, $20, $21, $22, $23, $24, $25, $01, $01, $01, $01, $01, $01, $01, $01,
$10, $11, $00, $00, $00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01, $01,
$00, $00, $00, $00, $00, $00, $12, $13, $01, $01, $01, $01, $01, $01, $01, $01,
$26, $14, $00, $00, $00, $00, $00, $00, $0B, $07, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $01, $01, $05,
$27, $16, $00, $00, $00, $00, $00, $00, $09, $01, $01, $01, $01, $01, $01, $01,
$00, $00, $00, $00, $00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01, $01,
$00, $00, $00, $00, $00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01, $01,
$00, $00, $00, $00, $00, $00, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
@ -225,17 +96,13 @@ $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $17,
$00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01, $01,
$01, $01, $01, $01, $01, $01, $01, $18,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00); $00, $01, $01, $01, $01, $04, $01, $0C);

40
packages/fcl-xml/src/xmlread.pp
View File

@ -282,7 +282,6 @@ type
FName: TWideCharBuf; FName: TWideCharBuf;
FTokenStart: TLocation; FTokenStart: TLocation;
FStandalone: Boolean; FStandalone: Boolean;
FNamePages: PByteArray;
FDocType: TDTDModel; FDocType: TDTDModel;
FPEMap: THashTable; FPEMap: THashTable;
FForwardRefs: TFPList; FForwardRefs: TFPList;
@ -321,7 +320,6 @@ type
procedure EntityToSource(AEntity: TEntityDecl; out Src: TXMLCharSource); procedure EntityToSource(AEntity: TEntityDecl; out Src: TXMLCharSource);
function ContextPush(AEntity: TEntityDecl): Boolean; function ContextPush(AEntity: TEntityDecl): Boolean;
function ContextPop(Forced: Boolean = False): Boolean; function ContextPop(Forced: Boolean = False): Boolean;
procedure XML11_BuildTables;
function ParseQuantity: TCPQuant; function ParseQuantity: TCPQuant;
procedure StoreLocation(out Loc: TLocation); procedure StoreLocation(out Loc: TLocation);
function ValidateAttrSyntax(AttrDef: TAttributeDef; const aValue: XMLString): Boolean; function ValidateAttrSyntax(AttrDef: TAttributeDef; const aValue: XMLString): Boolean;
@ -817,7 +815,7 @@ begin
end; end;
FBufSize := 2047; FBufSize := 2047;
if FReader.FXML11 then if FReader.FXML11 then
FReader.XML11_BuildTables; FXml11Rules := True;
end; end;
function TXMLDecodingSource.SetEncoding(const AEncoding: string): Boolean; function TXMLDecodingSource.SetEncoding(const AEncoding: string): Boolean;
@ -1148,8 +1146,8 @@ begin
if FSource.FBuf > FSource.FBufEnd-2 then if FSource.FBuf > FSource.FBufEnd-2 then
FSource.Reload; FSource.Reload;
if (not PercentAloneIsOk) or (Byte(FSource.FBuf[1]) in NamingBitmap[FNamePages^[$100+hi(Word(FSource.FBuf[1]))]]) or if (not PercentAloneIsOk) or (Byte(FSource.FBuf[1]) in NamingBitmap[NamePages[hi(Word(FSource.FBuf[1]))]]) or
(FXML11 and (FSource.FBuf[1] >= #$D800) and (FSource.FBuf[1] <= #$DB7F)) then ((FSource.FBuf[1] >= #$D800) and (FSource.FBuf[1] <= #$DB7F)) then
begin begin
Inc(FSource.FBuf); // skip '%' Inc(FSource.FBuf); // skip '%'
CheckName; CheckName;
@ -1242,8 +1240,6 @@ begin
FForwardRefs := TFPList.Create; FForwardRefs := TFPList.Create;
FAttrChunks := TFPList.Create; FAttrChunks := TFPList.Create;
// Set char rules to XML 1.0
FNamePages := @NamePages;
SetLength(FNodeStack, 16); SetLength(FNodeStack, 16);
SetLength(FValidators, 16); SetLength(FValidators, 16);
end; end;
@ -1292,12 +1288,6 @@ begin
inherited Destroy; inherited Destroy;
end; end;
procedure TXMLTextReader.XML11_BuildTables;
begin
FNamePages := Xml11NamePages;
FXML11 := True;
FSource.FXml11Rules := True;
end;
{ Must be executed after doc has been set. { Must be executed after doc has been set.
After introducing own NameTable, merge this into constructor } After introducing own NameTable, merge this into constructor }
@ -1385,10 +1375,10 @@ begin
repeat repeat
if NameStartFlag then if NameStartFlag then
begin begin
if (Byte(p^) in NamingBitmap[FNamePages^[hi(Word(p^))]]) or if (Byte(p^) in NamingBitmap[NamePages[hi(Word(p^))]]) or
((p^ = ':') and (not FNamespaces)) then ((p^ = ':') and (not FNamespaces)) then
Inc(p) Inc(p)
else if FXML11 and ((p^ >= #$D800) and (p^ <= #$DB7F) and else if ((p^ >= #$D800) and (p^ <= #$DB7F) and
(p[1] >= #$DC00) and (p[1] <= #$DFFF)) then (p[1] >= #$DC00) and (p[1] <= #$DFFF)) then
Inc(p, 2) Inc(p, 2)
else else
@ -1402,19 +1392,15 @@ begin
NameStartFlag := False; NameStartFlag := False;
end; end;
if FXML11 then
repeat repeat
if Byte(p^) in NamingBitmap[FNamePages^[$100+hi(Word(p^))]] then if Byte(p^) in NamingBitmap[NamePages[$100+hi(Word(p^))]] then
Inc(p) Inc(p)
else if ((p^ >= #$D800) and (p^ <= #$DB7F) and else if ((p^ >= #$D800) and (p^ <= #$DB7F) and
(p[1] >= #$DC00) and (p[1] <= #$DFFF)) then (p[1] >= #$DC00) and (p[1] <= #$DFFF)) then
Inc(p,2) Inc(p,2)
else else
Break; Break;
until False until False;
else
while Byte(p^) in NamingBitmap[FNamePages^[$100+hi(Word(p^))]] do
Inc(p);
if p^ = ':' then if p^ = ':' then
begin begin
@ -1936,6 +1922,8 @@ begin
ExpectString('version'); ExpectString('version');
ExpectEq; ExpectEq;
SkipQuote(Delim); SkipQuote(Delim);
{ !! Definition "VersionNum ::= '1.' [0-9]+" per XML 1.0 Fifth Edition
implies that version literal can have unlimited length. }
I := 0; I := 0;
while (I < 3) and (FSource.FBuf^ <> Delim) do while (I < 3) and (FSource.FBuf^ <> Delim) do
begin begin
@ -1944,7 +1932,7 @@ begin
FSource.NextChar; FSource.NextChar;
end; end;
if (I <> 3) or (buf[0] <> '1') or (buf[1] <> '.') or if (I <> 3) or (buf[0] <> '1') or (buf[1] <> '.') or
((buf[2] <> '0') and (buf[2] <> '1')) then (buf[2] < '0') or (buf[2] > '9') then
FatalError('Illegal version number', -1); FatalError('Illegal version number', -1);
ExpectChar(Delim); ExpectChar(Delim);
@ -3560,12 +3548,12 @@ end;
function TXMLTextReader.ValidateAttrSyntax(AttrDef: TAttributeDef; const aValue: XMLString): Boolean; function TXMLTextReader.ValidateAttrSyntax(AttrDef: TAttributeDef; const aValue: XMLString): Boolean;
begin begin
case AttrDef.DataType of case AttrDef.DataType of
dtId, dtIdRef, dtEntity: Result := IsXmlName(aValue, FXML11) and dtId, dtIdRef, dtEntity: Result := IsXmlName(aValue) and
((not FNamespaces) or (Pos(WideChar(':'), aValue) = 0)); ((not FNamespaces) or (Pos(WideChar(':'), aValue) = 0));
dtIdRefs, dtEntities: Result := IsXmlNames(aValue, FXML11) and dtIdRefs, dtEntities: Result := IsXmlNames(aValue) and
((not FNamespaces) or (Pos(WideChar(':'), aValue) = 0)); ((not FNamespaces) or (Pos(WideChar(':'), aValue) = 0));
dtNmToken: Result := IsXmlNmToken(aValue, FXML11) and AttrDef.HasEnumToken(aValue); dtNmToken: Result := IsXmlNmToken(aValue) and AttrDef.HasEnumToken(aValue);
dtNmTokens: Result := IsXmlNmTokens(aValue, FXML11); dtNmTokens: Result := IsXmlNmTokens(aValue);
// IsXmlName() not necessary - enum is never empty and contains valid names // IsXmlName() not necessary - enum is never empty and contains valid names
dtNotation: Result := AttrDef.HasEnumToken(aValue); dtNotation: Result := AttrDef.HasEnumToken(aValue);
else else

86
packages/fcl-xml/src/xmlutils.pp
View File

@ -34,7 +34,7 @@ function IsXmlNames(const Value: XMLString; Xml11: Boolean = False): Boolean;
function IsXmlNmToken(const Value: XMLString; Xml11: Boolean = False): Boolean; function IsXmlNmToken(const Value: XMLString; Xml11: Boolean = False): Boolean;
function IsXmlNmTokens(const Value: XMLString; Xml11: Boolean = False): Boolean; function IsXmlNmTokens(const Value: XMLString; Xml11: Boolean = False): Boolean;
function IsValidXmlEncoding(const Value: XMLString): Boolean; function IsValidXmlEncoding(const Value: XMLString): Boolean;
function Xml11NamePages: PByteArray;
procedure NormalizeSpaces(var Value: XMLString); procedure NormalizeSpaces(var Value: XMLString);
function IsXmlWhiteSpace(c: WideChar): Boolean; function IsXmlWhiteSpace(c: WideChar): Boolean;
function Hash(InitValue: LongWord; Key: PWideChar; KeyLen: Integer): LongWord; function Hash(InitValue: LongWord; Key: PWideChar; KeyLen: Integer): LongWord;
@ -231,37 +231,6 @@ function Decode_8859_1(Context: Pointer; InBuf: PChar; var InCnt: Cardinal; OutB
implementation implementation
var
Xml11Pg: PByteArray = nil;
function Xml11NamePages: PByteArray;
var
I: Integer;
p: PByteArray;
begin
if Xml11Pg = nil then
begin
GetMem(p, 512);
for I := 0 to 255 do
p^[I] := ord(Byte(I) in Xml11HighPages);
p^[0] := 2;
p^[3] := $2c;
p^[$20] := $2a;
p^[$21] := $2b;
p^[$2f] := $29;
p^[$30] := $2d;
p^[$fd] := $28;
p^[$ff] := $30;
Move(p^, p^[256], 256);
p^[$100] := $19;
p^[$103] := $2E;
p^[$120] := $2F;
Xml11Pg := p;
end;
Result := Xml11Pg;
end;
function IsXml11Char(Value: PWideChar; var Index: Integer): Boolean; overload; function IsXml11Char(Value: PWideChar; var Index: Integer): Boolean; overload;
begin begin
if (Value[Index] >= #$D800) and (Value[Index] <= #$DB7F) then if (Value[Index] >= #$D800) and (Value[Index] <= #$DB7F) then
@ -291,26 +260,18 @@ end;
function IsXmlName(Value: PWideChar; Len: Integer; Xml11: Boolean = False): Boolean; function IsXmlName(Value: PWideChar; Len: Integer; Xml11: Boolean = False): Boolean;
var var
Pages: PByteArray;
I: Integer; I: Integer;
begin begin
Result := False; Result := False;
if Xml11 then
Pages := Xml11NamePages
else
Pages := @NamePages;
I := 0; I := 0;
if (Len = 0) or not ((Byte(Value[I]) in NamingBitmap[Pages^[hi(Word(Value[I]))]]) or if (Len = 0) or not ((Byte(Value[I]) in NamingBitmap[NamePages[hi(Word(Value[I]))]]) or
(Value[I] = ':') or (Value[I] = ':') or IsXml11Char(Value, I)) then
(Xml11 and IsXml11Char(Value, I))) then
Exit; Exit;
Inc(I); Inc(I);
while I < Len do while I < Len do
begin begin
if not ((Byte(Value[I]) in NamingBitmap[Pages^[$100+hi(Word(Value[I]))]]) or if not ((Byte(Value[I]) in NamingBitmap[NamePages[$100+hi(Word(Value[I]))]]) or
(Value[I] = ':') or (Value[I] = ':') or IsXml11Char(Value, I)) then
(Xml11 and IsXml11Char(Value, I))) then
Exit; Exit;
Inc(I); Inc(I);
end; end;
@ -319,14 +280,9 @@ end;
function IsXmlNames(const Value: XMLString; Xml11: Boolean): Boolean; function IsXmlNames(const Value: XMLString; Xml11: Boolean): Boolean;
var var
Pages: PByteArray;
I: Integer; I: Integer;
Offset: Integer; Offset: Integer;
begin begin
if Xml11 then
Pages := Xml11NamePages
else
Pages := @NamePages;
Result := False; Result := False;
if Value = '' then if Value = '' then
Exit; Exit;
@ -334,9 +290,8 @@ begin
Offset := 0; Offset := 0;
while I <= Length(Value) do while I <= Length(Value) do
begin begin
if not ((Byte(Value[I]) in NamingBitmap[Pages^[Offset+hi(Word(Value[I]))]]) or if not ((Byte(Value[I]) in NamingBitmap[NamePages[Offset+hi(Word(Value[I]))]]) or
(Value[I] = ':') or (Value[I] = ':') or IsXml11Char(Value, I)) then
(Xml11 and IsXml11Char(Value, I))) then
begin begin
if (I = Length(Value)) or (Value[I] <> #32) then if (I = Length(Value)) or (Value[I] <> #32) then
Exit; Exit;
@ -353,21 +308,15 @@ end;
function IsXmlNmToken(const Value: XMLString; Xml11: Boolean): Boolean; function IsXmlNmToken(const Value: XMLString; Xml11: Boolean): Boolean;
var var
I: Integer; I: Integer;
Pages: PByteArray;
begin begin
if Xml11 then
Pages := Xml11NamePages
else
Pages := @NamePages;
Result := False; Result := False;
if Value = '' then if Value = '' then
Exit; Exit;
I := 1; I := 1;
while I <= Length(Value) do while I <= Length(Value) do
begin begin
if not ((Byte(Value[I]) in NamingBitmap[Pages^[$100+hi(Word(Value[I]))]]) or if not ((Byte(Value[I]) in NamingBitmap[NamePages[$100+hi(Word(Value[I]))]]) or
(Value[I] = ':') or (Value[I] = ':') or IsXml11Char(Value, I)) then
(Xml11 and IsXml11Char(Value, I))) then
Exit; Exit;
Inc(I); Inc(I);
end; end;
@ -377,21 +326,15 @@ end;
function IsXmlNmTokens(const Value: XMLString; Xml11: Boolean): Boolean; function IsXmlNmTokens(const Value: XMLString; Xml11: Boolean): Boolean;
var var
I: Integer; I: Integer;
Pages: PByteArray;
begin begin
if Xml11 then
Pages := Xml11NamePages
else
Pages := @NamePages;
I := 1; I := 1;
Result := False; Result := False;
if Value = '' then if Value = '' then
Exit; Exit;
while I <= Length(Value) do while I <= Length(Value) do
begin begin
if not ((Byte(Value[I]) in NamingBitmap[Pages^[$100+hi(Word(Value[I]))]]) or if not ((Byte(Value[I]) in NamingBitmap[NamePages[$100+hi(Word(Value[I]))]]) or
(Value[I] = ':') or (Value[I] = ':') or IsXml11Char(Value, I)) then
(Xml11 and IsXml11Char(Value, I))) then
begin begin
if (I = Length(Value)) or (Value[I] <> #32) then if (I = Length(Value)) or (Value[I] <> #32) then
Exit; Exit;
@ -1161,11 +1104,4 @@ begin
OutCnt := i; OutCnt := i;
end; end;
initialization
finalization
if Assigned(Xml11Pg) then
FreeMem(Xml11Pg);
end. end.

4
packages/fcl-xml/tests/xmlts.pp
View File

@ -37,6 +37,8 @@ const
parserName = parser; parserName = parser;
os = 'Unknown OS'; os = 'Unknown OS';
runtime = 'FPC RTL'; runtime = 'FPC RTL';
{ Defines which tests to skip (sets for editions 1-4 and edition 5 are mutually exclusive) }
FifthEditionCompliant = True;
type type
@ -362,7 +364,7 @@ begin
FTestID := Element['ID']; FTestID := Element['ID'];
TestType := Element['TYPE']; TestType := Element['TYPE'];
xmlEdition := Element['EDITION']; xmlEdition := Element['EDITION'];
if (xmlEdition <> '') and (Pos(WideChar('5'), Element['EDITION']) > 0) then if (xmlEdition <> '') and ((Pos(WideChar('5'), Element['EDITION']) = 0) = FifthEditionCompliant) then
begin begin
Inc(FSkipped); Inc(FSkipped);
Exit; Exit;