codetools+tests: function to fix xml attribute values

git-svn-id: trunk@32634 -

components/codetools/ctxmlfixfragment.pas

@@ -33,12 +33,16 @@ interface
 uses
   Classes, SysUtils, FileProcs, contnrs, BasicCodeTools;
 
+type
+  PObjectList = ^TObjectList;
+
 procedure FixFPDocFragment(var Fragment: string;
   AllowTags,    // for attribute values set this to false, so that all < are converted
   Fix: boolean; // fix errors using heuristics creating valid xml
-  out ErrorList: TObjectList;
+  ErrorList: PObjectList = nil;
   Verbose: boolean = false // write debugln to stdout
   );
+procedure FixFPDocAttributeValue(var Value: string);
 
 implementation
 
@@ -51,7 +55,7 @@ type
   end;
 
 procedure FixFPDocFragment(var Fragment: string; AllowTags, Fix: boolean;
-  out ErrorList: TObjectList; Verbose: boolean);
+  ErrorList: PObjectList; Verbose: boolean);
 { - Fix all tags to lowercase to reduce svn commits
   - auto close comments
   - remove #0 from comments
@@ -105,12 +109,13 @@ var
                           copy(Fragment,Rel(ErrorPos),LineEnd-Rel(ErrorPos)+1)]);
     end;
     if not Fix then exit;
-    if ErrorList=nil then
-      ErrorList:=TObjectList.Create(true);
+    if ErrorList=nil then exit;
+    if ErrorList^=nil then
+      ErrorList^:=TObjectList.Create(true);
     NewError:=TFPDocFragmentError.Create;
     NewError.ErrorPos:=Rel(ErrorPos);
     NewError.Msg:=ErrorMsg;
-    ErrorList.Add(NewError);
+    ErrorList^.Add(NewError);
   end;
 
   procedure Replace(StartPos, Len: integer; const NewTxt: string);
@@ -486,7 +491,6 @@ var
   end;
 
 begin
-  ErrorList:=nil;
   if Fragment='' then exit;
   Top:=-1;
   TopItem:=nil;
@@ -514,6 +518,9 @@ begin
         HandleSpecialChar;
       '&':
         ParseAmpersand;
+      '"','''':
+        if not AllowTags then
+          HandleSpecialChar;
       else
         inc(p);
       end;
@@ -530,5 +537,10 @@ begin
   end;
 end;
 
+procedure FixFPDocAttributeValue(var Value: string);
+begin
+  FixFPDocFragment(Value,false,true);
+end;
+
 end.
 

ide/codehelp.pas

@@ -44,7 +44,7 @@ uses
   // codetools
   CodeAtom, CodeTree, CodeToolManager, FindDeclarationTool, BasicCodeTools,
   KeywordFuncLists, PascalParserTool, CodeCache, CacheCodeTools, CustomCodeTool,
-  FileProcs,
+  FileProcs, CTXMLFixFragment,
   {$IFNDEF OldXMLCfg}
   Laz2_DOM, Laz2_XMLRead, Laz2_XMLWrite,
   {$ELSE}
@@ -1889,6 +1889,7 @@ begin
       CodeNode:=CodeNode.Parent;
     end;
   end;
+  //FixFPDocAttributeValue(Result);
 end;
 
 function TCodeHelpManager.GetFPDocNode(Tool: TCodeTool; CodeNode: TCodeTreeNode;

ide/fpdoceditwindow.pas

@@ -1270,29 +1270,23 @@ var
   function SetValue(Item: TFPDocItem): boolean;
   var
     NewValue: String;
-    ErrorList: TObjectList;
   begin
     Result:=false;
     NewValue:=Values[Item];
-    ErrorList:=nil;
     try
-      try
-        FixFPDocFragment(NewValue,
-               Item in [fpdiShort,fpdiDescription,fpdiErrors,fpdiSeeAlso],
-               true,ErrorList);
-        CurDocFile.SetChildValue(TopNode,FPDocItemNames[Item],NewValue);
-        Result:=true;
-      except
-        on E: EXMLReadError do begin
-          DebugLn(['SetValue ',dbgs(E.LineCol),' Name=',FPDocItemNames[Item]]);
-          JumpToError(Item,E.LineCol);
-          MessageDlg(lisFPDocFPDocSyntaxError,
-            Format(lisFPDocThereIsASyntaxErrorInTheFpdocElement, [FPDocItemNames
-              [Item], #13#13, E.Message]), mtError, [mbOk], '');
-        end;
+      FixFPDocFragment(NewValue,
+             Item in [fpdiShort,fpdiDescription,fpdiErrors,fpdiSeeAlso],
+             true);
+      CurDocFile.SetChildValue(TopNode,FPDocItemNames[Item],NewValue);
+      Result:=true;
+    except
+      on E: EXMLReadError do begin
+        DebugLn(['SetValue ',dbgs(E.LineCol),' Name=',FPDocItemNames[Item]]);
+        JumpToError(Item,E.LineCol);
+        MessageDlg(lisFPDocFPDocSyntaxError,
+          Format(lisFPDocThereIsASyntaxErrorInTheFpdocElement, [FPDocItemNames
+            [Item], #13#13, E.Message]), mtError, [mbOk], '');
       end;
-    finally
-      FreeAndNil(ErrorList);
     end;
   end;
 

test/codetoolstests/testctxmlfixfragments.pas

@@ -4,6 +4,7 @@
 
  Test individually:
      ./runtests --format=plain --suite=TestFixXMLFragmentComment
+     ./runtests --format=plain --suite=TestFixXMLValue
 }
 unit TestCTXMLFixFragments;
 
@@ -12,7 +13,7 @@ unit TestCTXMLFixFragments;
 interface
 
 uses
-  fpcunit, Classes, SysUtils, FileProcs, contnrs, testglobals, CTXMLFixFragment;
+  fpcunit, Classes, SysUtils, FileProcs, testglobals, CTXMLFixFragment;
 
 type
 
@@ -20,7 +21,8 @@ type
 
   TTestCTXMLFixFragment = class(TTestCase)
   protected
-    function Test(Title, Fragment, FixedFragment: string): boolean;
+    function TestFrag(Title, Fragment, FixedFragment: string): boolean;
+    function TestAttr(Title, Value, FixedValue: string): boolean;
   published
     procedure TestFixXMLFragmentComment;
     procedure TestFixXMLFragmentInvalidCharacters;
@@ -28,76 +30,95 @@ type
     procedure TestFixXMLFragmentAttribute;
     procedure TestFixXMLFragmentCloseTag;
     procedure TestFixXMLFragmentBugReports;
+    // attribute value
+    procedure TestFixXMLValue;
   end;
 
 implementation
 
 { TTestCTXMLFixFragment }
 
-function TTestCTXMLFixFragment.Test(Title, Fragment, FixedFragment: string
+function TTestCTXMLFixFragment.TestFrag(Title, Fragment, FixedFragment: string
   ): boolean;
 var
   s: String;
-  ErrorList: TObjectList;
 begin
   Result:=true;
-  try
-    s:=Fragment;
-    FixFPDocFragment(s,true,true,ErrorList,false);
-    AssertEquals(Title+' fragment: '+DbgStr(Fragment),dbgstr(FixedFragment),dbgstr(s));
-  finally
-    ErrorList.Free;
-  end;
+  s:=Fragment;
+  FixFPDocFragment(s,true,true,nil,false);
+  AssertEquals(Title+' fragment: '+DbgStr(Fragment),dbgstr(FixedFragment),dbgstr(s));
+end;
+
+function TTestCTXMLFixFragment.TestAttr(Title, Value, FixedValue: string
+  ): boolean;
+var
+  s: String;
+begin
+  Result:=true;
+  s:=Value;
+  FixFPDocAttributeValue(s);
+  AssertEquals(Title+' value: '+DbgStr(Value),dbgstr(FixedValue),dbgstr(s));
 end;
 
 procedure TTestCTXMLFixFragment.TestFixXMLFragmentComment;
 begin
-  Test('close comment','<!--','<!---->');
-  Test('close comment and delete invalid char','<!--null'#0#1#2'comment','<!--nullcomment-->');
+  TestFrag('close comment','<!--','<!---->');
+  TestFrag('close comment and delete invalid char','<!--null'#0#1#2'comment','<!--nullcomment-->');
 end;
 
 procedure TTestCTXMLFixFragment.TestFixXMLFragmentInvalidCharacters;
 begin
-  Test('delete special characters','A'#0'B'#1#127,'AB');
-  Test('replace tag characters','LT< GT>AMP&','LT&lt; GT&gt;AMP&amp;');
-  Test('lower case special characters','&LT;','&lt;');
+  TestFrag('delete special characters','A'#0'B'#1#127,'AB');
+  TestFrag('replace tag characters','LT< GT>AMP&','LT&lt; GT&gt;AMP&amp;');
+  TestFrag('lower case special characters','&LT;','&lt;');
 end;
 
 procedure TTestCTXMLFixFragment.TestFixXMLFragmentOpenTag;
 begin
-  Test('valid short tag','<link/>','<link/>');
-  Test('valid short with empty attribute tag','<link id=""/>','<link id=""/>');
-  Test('missing tag name','<>','&lt;&gt;');
-  Test('lower case tag name','<A></a>','<a></a>');
-  Test('invalid character in tag','<a "></a>','<a >"&gt;</a>');
+  TestFrag('valid short tag','<link/>','<link/>');
+  TestFrag('valid short with empty attribute tag','<link id=""/>','<link id=""/>');
+  TestFrag('missing tag name','<>','&lt;&gt;');
+  TestFrag('lower case tag name','<A></a>','<a></a>');
+  TestFrag('invalid character in tag','<a "></a>','<a >"&gt;</a>');
 end;
 
 procedure TTestCTXMLFixFragment.TestFixXMLFragmentAttribute;
 begin
-  Test('lower case attribute name','<a Name=""></a>','<a name=""></a>');
-  Test('missing attribute equal','<a name ""></a>','<a name =""></a>');
-  Test('missing attribute value','<a name=></a>','<a name=""></a>');
-  Test('missing attribute quotes','<a name=1></a>','<a name="1"></a>');
-  Test('missing attribute ending quote','<a name="1></a>','<a name="1"></a>');
-  Test('invalid character in attribute value','<a name="&"></a>','<a name="&amp;"></a>');
-  Test('amp attribute value','<a name="&amp;"></a>','<a name="&amp;"></a>');
+  TestFrag('lower case attribute name','<a Name=""></a>','<a name=""></a>');
+  TestFrag('missing attribute equal','<a name ""></a>','<a name =""></a>');
+  TestFrag('missing attribute value','<a name=></a>','<a name=""></a>');
+  TestFrag('missing attribute quotes','<a name=1></a>','<a name="1"></a>');
+  TestFrag('missing attribute ending quote','<a name="1></a>','<a name="1"></a>');
+  TestFrag('invalid character in xml fragment attribute value','<a name="&"></a>','<a name="&amp;"></a>');
+  TestFrag('amp attribute value','<a name="&amp;"></a>','<a name="&amp;"></a>');
 end;
 
 procedure TTestCTXMLFixFragment.TestFixXMLFragmentCloseTag;
 begin
-  Test('lower case close tag name','<a></A>','<a></a>');
-  Test('close open tag','<a>','<a/>');
-  Test('close open sub tag','<p><a></p>','<p><a/></p>');
-  Test('disable invalid close tag','</p>','&lt;/p&gt;');
+  TestFrag('lower case close tag name','<a></A>','<a></a>');
+  TestFrag('close open tag','<a>','<a/>');
+  TestFrag('close open sub tag','<p><a></p>','<p><a/></p>');
+  TestFrag('disable invalid close tag','</p>','&lt;/p&gt;');
 end;
 
 procedure TTestCTXMLFixFragment.TestFixXMLFragmentBugReports;
 begin
-  Test('15120','operator <(TPoint, TPoint): Boolean',
+  TestFrag('15120','operator <(TPoint, TPoint): Boolean',
                  'operator &lt;(TPoint, TPoint): Boolean');
-  Test('16671','<br>',
+  TestFrag('16671','<br>',
                '<br/>');
-  Test('18800','<link id="foo"/>','<link id="foo"/>');
+  TestFrag('18800','<link id="foo"/>','<link id="foo"/>');
+end;
+
+procedure TTestCTXMLFixFragment.TestFixXMLValue;
+begin
+  TestAttr('invalid character in xml attribute value','operator<','operator&lt;');
+  TestAttr('correct character in xml attribute value','&amp;','&amp;');
+  TestAttr('lower case character name in attribute value','&AMP;','&amp;');
+  TestAttr('" in attribute value','"','&quot;');
+  TestAttr(''' in attribute value','''','&apos;');
+  TestAttr('< in attribute value','<','&lt;');
+  TestAttr('> in attribute value','>','&gt;');
 end;
 
 initialization

test/runtests.lpi

@@ -129,6 +129,12 @@
         <StackChecks Value="True"/>
       </Checks>
     </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="True"/>
+        <DebugInfoType Value="dsAuto"/>
+      </Debugging>
+    </Linking>
     <Other>
       <CompilerMessages>
         <UseMsgFile Value="True"/>