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

* xmlread.pp, continue separating validation checks from the rest of code.

Browse Source 
* Fixed reported locations for (hopefully) all namespace-related errors.

git-svn-id: trunk@16959 -
This commit is contained in:
sergei 2011-02-21 01:50:49 +00:00
parent 36ec05961f
commit 8ed16bb3ab
2 changed files with 50 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -292,7 +292,6 @@ type
FAttrTag: Cardinal; FAttrTag: Cardinal;
FDTDProcessed: Boolean; FDTDProcessed: Boolean;
FFragmentMode: Boolean; FFragmentMode: Boolean;
FToken: TXMLToken;
FNext: TXMLToken; FNext: TXMLToken;
FCurrEntity: TEntityDecl; FCurrEntity: TEntityDecl;
FIDMap: THashTable; FIDMap: THashTable;
@ -336,7 +335,7 @@ type
function SkipUntilSeq(const Delim: TSetOfChar; c1: WideChar; c2: WideChar = #0): Boolean; function SkipUntilSeq(const Delim: TSetOfChar; c1: WideChar; c2: WideChar = #0): Boolean;
procedure CheckMaxChars(ToAdd: Cardinal); procedure CheckMaxChars(ToAdd: Cardinal);
function AllocNodeData(AIndex: Integer): PNodeData; function AllocNodeData(AIndex: Integer): PNodeData;
function AllocAttributeData(AName: PHashItem): PNodeData; function AllocAttributeData: PNodeData;
function AllocAttributeValueChunk(APrev: PNodeData): PNodeData; function AllocAttributeValueChunk(APrev: PNodeData): PNodeData;
procedure CleanupAttribute(aNode: PNodeData); procedure CleanupAttribute(aNode: PNodeData);
procedure CleanupAttributes; procedure CleanupAttributes;
@ -376,7 +375,7 @@ type
function ExpectName: WideString; // [5] function ExpectName: WideString; // [5]
function ParseLiteral(var ToFill: TWideCharBuf; aType: TLiteralType; function ParseLiteral(var ToFill: TWideCharBuf; aType: TLiteralType;
Required: Boolean): Boolean; Required: Boolean): Boolean;
function ExpectAttValue(attrData: PNodeData; NonCDATA: Boolean): Boolean; // [10] procedure ExpectAttValue(attrData: PNodeData; NonCDATA: Boolean); // [10]
procedure ParseComment(discard: Boolean); // [15] procedure ParseComment(discard: Boolean); // [15]
procedure ParsePI; // [16] procedure ParsePI; // [16]
procedure CreatePINode; procedure CreatePINode;
@ -1563,9 +1562,9 @@ const
{ Parse attribute literal, producing plain string value in AttrData.FValueStr. { Parse attribute literal, producing plain string value in AttrData.FValueStr.
If entity references are encountered and FExpandEntities=False, also builds If entity references are encountered and FExpandEntities=False, also builds
a node chain starting from AttrData.FNext. Node chain is built only for the a node chain starting from AttrData.FNext. Node chain is built only for the
first level. If NonCDATA=True, additionally normalizes whitespace in string value. first level. If NonCDATA=True, additionally normalizes whitespace in string value. }
Returns True if value actually needed normalization }
function TXMLReader.ExpectAttValue(AttrData: PNodeData; NonCDATA: Boolean): Boolean; procedure TXMLReader.ExpectAttValue(AttrData: PNodeData; NonCDATA: Boolean);
var var
wc: WideChar; wc: WideChar;
Delim: WideChar; Delim: WideChar;
@ -1637,9 +1636,9 @@ begin
end; end;
end; end;
if nonCDATA then if nonCDATA then
BufNormalize(FValue, Result) BufNormalize(FValue, attrData^.FDenormalized)
else else
Result := False; attrData^.FDenormalized := False;
SetString(attrData^.FValueStr, FValue.Buffer, FValue.Length); SetString(attrData^.FValueStr, FValue.Buffer, FValue.Length);
end; end;
@ -2678,6 +2677,9 @@ end;
procedure TXMLReader.ValidateCurrentNode; procedure TXMLReader.ValidateCurrentNode;
var var
ElDef: TElementDecl; ElDef: TElementDecl;
AttDef: TAttributeDef;
attr: PNodeData;
i: Integer;
begin begin
case FCurrNode^.FNodeType of case FCurrNode^.FNodeType of
ntElement: ntElement:
@ -2699,6 +2701,32 @@ begin
if not FValidators[FNesting-1].IsElementAllowed(ElDef) then if not FValidators[FNesting-1].IsElementAllowed(ElDef) then
DoErrorPos(esError, 'Element ''%s'' is not allowed in this context',[FCurrNode^.FQName^.Key], FCurrNode^.FLoc); DoErrorPos(esError, 'Element ''%s'' is not allowed in this context',[FCurrNode^.FQName^.Key], FCurrNode^.FLoc);
{ Validate attributes }
for i := 1 to FAttrCount do
begin
attr := @FNodeStack[FNesting+i];
AttDef := TAttributeDef(attr^.FTypeInfo);
if AttDef = nil then
DoErrorPos(esError, 'Using undeclared attribute ''%s'' on element ''%s''',
[attr^.FQName^.Key, FCurrNode^.FQName^.Key], attr^.FLoc)
else if ((AttDef.DataType <> dtCdata) or (AttDef.Default = adFixed)) then
begin
if FStandalone and AttDef.ExternallyDeclared then
{ TODO: perhaps should use different and more descriptive messages }
if attr^.FDenormalized then
DoErrorPos(esError, 'Standalone constraint violation', attr^.FLoc2)
else if i > FSpecifiedAttrs then
DoError(esError, 'Standalone constraint violation');
// TODO: what about normalization of AttDef.Value? (Currently it IS normalized)
if (AttDef.Default = adFixed) and (AttDef.Data^.FValueStr <> attr^.FValueStr) then
DoErrorPos(esError, 'Value of attribute ''%s'' does not match its #FIXED default',[attr^.FQName^.Key], attr^.FLoc2);
if not ValidateAttrSyntax(AttDef, attr^.FValueStr) then
DoErrorPos(esError, 'Attribute ''%s'' type mismatch', [attr^.FQName^.Key], attr^.FLoc2);
ValidateAttrValue(AttDef, attr);
end;
end;
end; end;
ntEndElement: ntEndElement:
@ -2911,7 +2939,6 @@ begin
if FNext = xtPopEmptyElement then if FNext = xtPopEmptyElement then
begin begin
FNext := xtPopElement; FNext := xtPopElement;
FToken := xtEndElement;
FCurrNode^.FNodeType := ntEndElement; FCurrNode^.FNodeType := ntEndElement;
if FAttrCleanupFlag then if FAttrCleanupFlag then
CleanupAttributes; CleanupAttributes;
@ -3020,7 +3047,6 @@ begin
if FCDSectionsAsText then if FCDSectionsAsText then
Continue; Continue;
SetNodeInfoWithValue(ntCDATA); SetNodeInfoWithValue(ntCDATA);
FToken := xtCDSect;
FNext := xtText; FNext := xtText;
Result := True; Result := True;
Exit; Exit;
@ -3055,7 +3081,6 @@ begin
if FValue.Length <> 0 then if FValue.Length <> 0 then
begin begin
SetNodeInfoWithValue(textNodeTypes[nonWs]); SetNodeInfoWithValue(textNodeTypes[nonWs]);
if nonWs then FToken := xtText else FToken := xtWhitespace;
FNext := tok; FNext := tok;
Result := True; Result := True;
Exit; Exit;
@ -3065,7 +3090,6 @@ begin
else // not (FNext in [xtText, xtCDSect]) else // not (FNext in [xtText, xtCDSect])
tok := FNext; tok := FNext;
FToken := tok;
FNext := xtText; FNext := xtText;
case tok of case tok of
@ -3170,10 +3194,7 @@ begin
begin begin
b := TBinding(FCurrNode^.FPrefix^.Data); b := TBinding(FCurrNode^.FPrefix^.Data);
if not (Assigned(b) and (b.uri <> '')) then if not (Assigned(b) and (b.uri <> '')) then
begin DoErrorPos(esFatal, 'Unbound element name prefix "%s"', [FCurrNode^.FPrefix^.Key],FCurrNode^.FLoc);
FTokenStart := FCurrNode^.FLoc;
FatalError('Unbound element name prefix "%s"', [FCurrNode^.FPrefix^.Key],-1);
end;
FCurrNode^.FNsUri := FNameTable.FindOrAdd(PWideChar(b.uri), Length(b.uri)); FCurrNode^.FNsUri := FNameTable.FindOrAdd(PWideChar(b.uri), Length(b.uri));
end end
else else
@ -3226,22 +3247,11 @@ var
attrData: PNodeData; attrData: PNodeData;
AttDef: TAttributeDef; AttDef: TAttributeDef;
i: Integer; i: Integer;
normalized: Boolean;
procedure CheckValue;
begin
// TODO: what about normalization of AttDef.Value? (Currently it IS normalized)
if (AttDef.Default = adFixed) and (AttDef.Data^.FValueStr <> attrData^.FValueStr) then
ValidationError('Value of attribute ''%s'' does not match its #FIXED default',[attrData^.FQName^.Key], -1);
if not ValidateAttrSyntax(AttDef, attrData^.FValueStr) then
ValidationError('Attribute ''%s'' type mismatch', [attrData^.FQName^.Key], -1);
ValidateAttrValue(AttDef, attrData);
end;
begin begin
CheckName; CheckName;
attrName := FNameTable.FindOrAdd(FName.Buffer, FName.Length); attrName := FNameTable.FindOrAdd(FName.Buffer, FName.Length);
attrData := AllocAttributeData(attrName); attrData := AllocAttributeData;
attrData^.FQName := attrName;
attrData^.FColonPos := FColonPos; attrData^.FColonPos := FColonPos;
StoreLocation(attrData^.FLoc); StoreLocation(attrData^.FLoc);
Dec(attrData^.FLoc.LinePos, FName.Length); Dec(attrData^.FLoc.LinePos, FName.Length);
@ -3250,10 +3260,7 @@ begin
if Assigned(ElDef) then if Assigned(ElDef) then
begin begin
AttDef := ElDef.GetAttrDef(attrName); AttDef := ElDef.GetAttrDef(attrName);
if AttDef = nil then if Assigned(AttDef) then
ValidationError('Using undeclared attribute ''%s'' on element ''%s''',
[attrName^.Key, FNodeStack[FNesting].FQName^.Key], FName.Length)
else
AttDef.Tag := FAttrTag; // indicates that this one is specified AttDef.Tag := FAttrTag; // indicates that this one is specified
end end
else else
@ -3284,15 +3291,9 @@ begin
end; end;
ExpectEq; ExpectEq;
normalized := ExpectAttValue(attrData, Assigned(AttDef) and (AttDef.DataType <> dtCDATA)); ExpectAttValue(attrData, Assigned(AttDef) and (AttDef.DataType <> dtCDATA));
attrData^.FLoc2 := FTokenStart;
if Assigned(AttDef) and ((AttDef.DataType <> dtCdata) or (AttDef.Default = adFixed)) then
begin
if normalized and FStandalone and AttDef.ExternallyDeclared then
StandaloneError(-1);
CheckValue;
end;
if Assigned(attrData^.FNsUri) then if Assigned(attrData^.FNsUri) then
begin begin
if (not AddBinding(attrData)) and FCanonical then if (not AddBinding(attrData)) and FCanonical then
@ -3348,9 +3349,7 @@ begin
begin begin
case AttDef.Default of case AttDef.Default of
adDefault, adFixed: begin adDefault, adFixed: begin
if FStandalone and AttDef.ExternallyDeclared then attrData := AllocAttributeData;
StandaloneError;
attrData := AllocAttributeData(nil);
attrData^ := AttDef.Data^; attrData^ := AttDef.Data^;
if FCanonical then if FCanonical then
attrData^.FIsDefault := False; attrData^.FIsDefault := False;
@ -3396,13 +3395,13 @@ begin
(nsUri = FStduri_xmlns) then (nsUri = FStduri_xmlns) then
begin begin
if (Pfx = FStdPrefix_xml) or (Pfx = FStdPrefix_xmlns) then if (Pfx = FStdPrefix_xml) or (Pfx = FStdPrefix_xmlns) then
FatalError('Illegal usage of reserved prefix ''%s''', [Pfx^.Key]) DoErrorPos(esFatal, 'Illegal usage of reserved prefix ''%s''', [Pfx^.Key], attrData^.FLoc)
else else
FatalError('Illegal usage of reserved namespace URI ''%s''', [attrData^.FValueStr]); DoErrorPos(esFatal, 'Illegal usage of reserved namespace URI ''%s''', [attrData^.FValueStr], attrData^.FLoc2);
end; end;
if (attrData^.FValueStr = '') and not (FXML11 or (Pfx^.Key = '')) then if (attrData^.FValueStr = '') and not (FXML11 or (Pfx^.Key = '')) then
FatalError('Illegal undefining of namespace'); { position - ? } DoErrorPos(esFatal, 'Illegal undefining of namespace', attrData^.FLoc2);
Result := (Pfx^.Data = nil) or (TBinding(Pfx^.Data).uri <> attrData^.FValueStr); Result := (Pfx^.Data = nil) or (TBinding(Pfx^.Data).uri <> attrData^.FValueStr);
if Result then if Result then
@ -3426,10 +3425,7 @@ begin
Pfx := attrData^.FPrefix; Pfx := attrData^.FPrefix;
b := TBinding(Pfx^.Data); b := TBinding(Pfx^.Data);
if not (Assigned(b) and (b.uri <> '')) then if not (Assigned(b) and (b.uri <> '')) then
begin DoErrorPos(esFatal, 'Unbound attribute name prefix "%s"', [Pfx^.Key], attrData^.FLoc);
FTokenStart := attrData^.FLoc;
FatalError('Unbound attribute name prefix "%s"', [Pfx^.Key], -1);
end;
{ detect duplicates } { detect duplicates }
J := attrData^.FColonPos+1; J := attrData^.FColonPos+1;
@ -3500,7 +3496,7 @@ begin
case AttrDef.DataType of case AttrDef.DataType of
dtId: begin dtId: begin
if not AddID(attrData) then if not AddID(attrData) then
ValidationError('The ID ''%s'' is not unique', [attrData^.FValueStr], -1); DoErrorPos(esError, 'The ID ''%s'' is not unique', [attrData^.FValueStr], attrData^.FLoc2);
end; end;
dtIdRef, dtIdRefs: begin dtIdRef, dtIdRefs: begin
@ -3610,11 +3606,10 @@ begin
aNodeData^.FIDEntry := e; aNodeData^.FIDEntry := e;
end; end;
function TXMLReader.AllocAttributeData(AName: PHashItem): PNodeData; function TXMLReader.AllocAttributeData: PNodeData;
begin begin
Result := AllocNodeData(FNesting + FAttrCount + 1); Result := AllocNodeData(FNesting + FAttrCount + 1);
Result^.FNodeType := ntAttribute; Result^.FNodeType := ntAttribute;
Result^.FQName := AName;
Result^.FPrefix := nil; Result^.FPrefix := nil;
Result^.FNsUri := nil; Result^.FNsUri := nil;
Result^.FIDEntry := nil; Result^.FIDEntry := nil;

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

@ -158,6 +158,7 @@ type
FValueStart: PWideChar; FValueStart: PWideChar;
FValueLength: Integer; FValueLength: Integer;
FIsDefault: Boolean; FIsDefault: Boolean;
FDenormalized: Boolean; // Whether attribute value changes by normalization
end; end;
{ TNSSupport provides tracking of prefix-uri pairs and namespace fixup for writer } { TNSSupport provides tracking of prefix-uri pairs and namespace fixup for writer }