Fix empty complexType parsing

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@552 8e941d3f-bd1b-0410-a28a-d453659cc2b4

wst/trunk/tests/test_suite/files/class_headerblock_derived.wsdl

@@ -10,6 +10,8 @@
   <types>
     <xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:wst-test">
     
+        <xsd:complexType name="TEmptyHeader" wst:wst_headerBlock="true" />
+        
         <xsd:complexType name="TSampleHeader" wst:wst_headerBlock="true">
           <xsd:sequence>
             <xsd:element name="intField" type="xsd:int"/>

wst/trunk/tests/test_suite/files/class_headerblock_derived.xsd

@@ -1,5 +1,8 @@
 <?xml version="1.0"?>
 <schema xmlns:tns="class_headerblock_derived" xmlns:wst="urn:wst_base" xmlns:xsd="http://www.w3.org/2001/XMLSchema" targetNamespace="class_headerblock_derived">
+  
+  <xsd:complexType name="TEmptyHeader" wst:wst_headerBlock="true" />
+  
   <xsd:complexType name="TSampleHeader" wst:wst_headerBlock="true">
     <xsd:sequence>
       <xsd:element name="intField" type="xsd:int"/>

wst/trunk/tests/test_suite/test_generators.pas

@@ -300,6 +300,13 @@ begin
     mdl := TPasModule(tr.CreateElement(TPasModule,'class_headerblock_derived',tr.Package,visDefault,'',0));
     tr.Package.Modules.Add(mdl);
     mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0));
+    cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TEmptyHeader',mdl.InterfaceSection,visDefault,'',0));
+      cltyp.ObjKind := okClass;
+      cltyp.AncestorType := tr.FindElementNS('THeaderBlock',s_xs) as TPasType;
+      cltyp.AncestorType.AddRef();
+      mdl.InterfaceSection.Declarations.Add(cltyp);
+      mdl.InterfaceSection.Types.Add(cltyp);
+
     cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TSampleHeader',mdl.InterfaceSection,visDefault,'',0));
       cltyp.ObjKind := okClass;
       cltyp.AncestorType := tr.FindElementNS('THeaderBlock',s_xs) as TPasType;

wst/trunk/tests/test_suite/test_parsers.pas

@@ -1172,7 +1172,7 @@ begin
 end;
 
 procedure TTest_CustomXsdParser.class_headerblock_derived();
-const s_class_name = 'TSampleHeader';
+const s_class_name = 'TSampleHeader'; s_emty_class_name = 'TEmptyHeader';
 var
   tr : TwstPasTreeContainer;
   mdl : TPasModule;
@@ -1183,6 +1183,14 @@ begin
   try
     mdl := tr.FindModule('class_headerblock_derived');
     CheckNotNull(mdl,'class_headerblock_derived');
+    elt := tr.FindElement(s_emty_class_name);
+      CheckNotNull(elt,s_emty_class_name);
+      CheckEquals(s_emty_class_name,elt.Name);
+      CheckEquals(s_emty_class_name,tr.GetExternalName(elt));
+      CheckIs(elt,TPasClassType);
+      clsType := elt as TPasClassType;
+      CheckNotNull(clsType.AncestorType,'AncestorType is null');
+      CheckSame(tr.FindElementNS('THeaderBlock',sXSD_NS),clsType.AncestorType);
     elt := tr.FindElement(s_class_name);
       CheckNotNull(elt,s_class_name);
       CheckEquals(s_class_name,elt.Name);
@@ -1191,6 +1199,7 @@ begin
       clsType := elt as TPasClassType;
       CheckNotNull(clsType.AncestorType,'AncestorType is null');
       CheckSame(tr.FindElementNS('THeaderBlock',sXSD_NS),clsType.AncestorType);
+
   finally
     tr.Free();
   end;

wst/trunk/ws_helper/ws_parser_imp.pas

@@ -125,6 +125,8 @@ type
       const AInternalName : string;
       const AHasInternalName : Boolean
     ) : TPasArrayType;
+    function IsHeaderBlock() : Boolean;
+    function IsSimpleContentHeaderBlock() : Boolean;
   private
     procedure CreateNodeCursors();
     procedure ExtractTypeName();
@@ -554,6 +556,20 @@ begin
     FSymbols.RegisterExternalAlias(Result,ATypeName);
 end;
 
+function TComplexTypeParser.IsHeaderBlock() : Boolean;
+var
+  strBuffer : string;
+begin
+  Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer));
+end;
+
+function TComplexTypeParser.IsSimpleContentHeaderBlock() : Boolean;
+var
+  strBuffer : string;
+begin
+  Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlockSimpleContent,strBuffer) and AnsiSameText('true',Trim(strBuffer));
+end;
+
 procedure TComplexTypeParser.CreateNodeCursors();
 begin
   FAttCursor := CreateAttributesCursor(FTypeNode,cetRttiNode);
@@ -866,20 +882,6 @@ var
     ExtractExtendedMetadata(locProp,AElement);
   end;
 
-  function IsHeaderBlock() : Boolean;
-  var
-    strBuffer : string;
-  begin
-    Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlock,strBuffer) and AnsiSameText('true',Trim(strBuffer));
-  end;
-
-  function IsSimpleContentHeaderBlock() : Boolean;
-  var
-    strBuffer : string;
-  begin
-    Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),FTypeNode,s_WST_headerBlockSimpleContent,strBuffer) and AnsiSameText('true',Trim(strBuffer));
-  end;
-  
   function IsRecordType() : Boolean;
   var
     strBuffer : string;
@@ -1213,7 +1215,12 @@ begin
   TPasClassType(Result).ObjKind := okClass;
   if hasInternalName then
     FSymbols.RegisterExternalAlias(Result,ATypeName);
-  TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType;
+  if IsHeaderBlock() then
+    TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('THeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
+  else if IsSimpleContentHeaderBlock() then
+    TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('TSimpleContentHeaderBlock',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType
+  else
+    TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType;
   TPasClassType(Result).AncestorType.AddRef();
 end;