Handle top level(global) declared attribute and references

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

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

@@ -0,0 +1,37 @@
+<?xml version="1.0"?>
+<definitions name="wst_test" 
+   xmlns="http://schemas.xmlsoap.org/wsdl/" 
+   xmlns:tns="library1" 
+   xmlns:xsd="http://www.w3.org/2001/XMLSchema" 
+   xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" 
+   targetNamespace="urn:wst-test">
+
+  <types>
+    <xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:wst-test">
+      
+        <xsd:attribute name="intAtt" type="xsd:int">
+        </xsd:attribute>
+        
+        <xsd:attribute name="strAtt" type="xsd:string"/>
+        
+          
+        <xsd:complexType name="TSampleClass">
+          <xsd:complexContent>
+            <xsd:attribute ref="n:intAtt" />
+            <xsd:attribute ref="n:strAtt" />
+          </xsd:complexContent>
+        </xsd:complexType>
+        
+        <xsd:complexType name="AttributedString">
+          <xsd:simpleContent>
+            <xsd:extension base="xsd:string">
+              <xsd:attribute ref="n:strAtt"/>
+            </xsd:extension>
+          </xsd:simpleContent>
+        </xsd:complexType>
+        
+    </xsd:schema>
+  </types>
+  
+
+</definitions>

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

@@ -0,0 +1,27 @@
+<?xml version="1.0" encoding="UTF-8"?>
+ <xsd:schema xmlns:n="urn:wst-test" 
+  xmlns:xsd="http://www.w3.org/2001/XMLSchema" 
+  targetNamespace="urn:wst-test">
+      
+	<xsd:attribute name="intAtt" type="xsd:int">
+	</xsd:attribute>
+  
+	<xsd:attribute name="strAtt" type="xsd:string"/>
+  
+    
+  <xsd:complexType name="TSampleClass">
+    <xsd:complexContent>
+      <xsd:attribute ref="n:intAtt" />
+      <xsd:attribute ref="n:strAtt" />
+    </xsd:complexContent>
+  </xsd:complexType>
+        
+  <xsd:complexType name="AttributedString">
+    <xsd:simpleContent>
+      <xsd:extension base="xsd:string">
+        <xsd:attribute ref="n:strAtt"/>
+      </xsd:extension>
+    </xsd:simpleContent>
+  </xsd:complexType>
+        
+</xsd:schema>

wst/trunk/tests/test_suite/test_parsers.pas

@@ -80,6 +80,8 @@ type
     function load_schema_case_sensitive() : TwstPasTreeContainer;virtual;abstract;
     function load_schema_case_sensitive2() : TwstPasTreeContainer;virtual;abstract;
     function load_schema_case_sensitive_import() : TwstPasTreeContainer;virtual;abstract;
+
+    function load_global_attribute() : TwstPasTreeContainer;virtual;abstract;
   published
     procedure EmptySchema();
 
@@ -132,6 +134,8 @@ type
     procedure case_sensitive();
     procedure case_sensitive2();
     procedure case_sensitive_import();
+
+    procedure global_attribute();
   end;
 
   { TTest_XsdParser }
@@ -189,6 +193,8 @@ type
     function load_schema_case_sensitive() : TwstPasTreeContainer;override;
     function load_schema_case_sensitive2() : TwstPasTreeContainer;override;
     function load_schema_case_sensitive_import() : TwstPasTreeContainer;override;
+
+    function load_global_attribute() : TwstPasTreeContainer;override;
   end;
 
   { TTest_WsdlParser }
@@ -246,6 +252,8 @@ type
     function load_schema_case_sensitive() : TwstPasTreeContainer;override;
     function load_schema_case_sensitive2() : TwstPasTreeContainer;override;
     function load_schema_case_sensitive_import() : TwstPasTreeContainer;override;
+
+    function load_global_attribute() : TwstPasTreeContainer;override;
   published
     procedure no_binding_style();
     procedure signature_last();
@@ -2704,6 +2712,52 @@ begin
   end;
 end;
 
+procedure TTest_CustomXsdParser.global_attribute();
+const s_class_name = 'TSampleClass';
+var
+  clsType : TPasClassType;
+  tr : TwstPasTreeContainer;
+
+  procedure CheckProperty(
+    const AName,
+          ADeclaredName,
+          ATypeName      : string;
+    const AFieldType     : TPropertyType
+  );
+  var
+    prp : TPasProperty;
+    t : TPasType;
+  begin
+    prp := FindMember(clsType,AName) as TPasProperty;
+      CheckNotNull(prp);
+      CheckEquals(AName,prp.Name,'Name');
+      CheckEquals(ADeclaredName,tr.GetExternalName(prp),'External Name');
+      CheckNotNull(prp.VarType);
+      t := GetUltimeType(prp.VarType);
+      CheckNotNull(t,'Property''s Ultime Type not found.');
+      CheckEquals(ATypeName,tr.GetExternalName(t),'TypeName');
+      CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp));
+  end;
+
+var
+  mdl : TPasModule;
+  elt : TPasElement;
+begin
+  tr := load_global_attribute();
+  try
+    mdl := tr.FindModule('urn:wst-test');
+    CheckNotNull(mdl,'urn:wst-test');
+    elt := tr.FindElement(s_class_name);
+      CheckNotNull(elt,s_class_name);
+      CheckIs(elt,TPasClassType);
+      clsType := elt as TPasClassType;
+      CheckProperty('intAtt','intAtt','int',ptAttribute);
+      CheckProperty('strAtt','strAtt','string',ptAttribute);
+  finally
+    tr.Free();
+  end;
+end;
+
 { TTest_XsdParser }
 
 function TTest_XsdParser.ParseDoc(
@@ -2896,6 +2950,11 @@ begin
   Result := ParseDoc('case_sensitive3',True);
 end;
 
+function TTest_XsdParser.load_global_attribute() : TwstPasTreeContainer;
+begin
+  Result := ParseDoc('global_attribute');
+end;
+
 function TTest_XsdParser.load_class_widechar_property() : TwstPasTreeContainer;
 begin
   Result := ParseDoc('class_widechar_property');
@@ -3722,6 +3781,11 @@ begin
   Result := ParseDoc('case_sensitive3',True);
 end;
 
+function TTest_WsdlParser.load_global_attribute() : TwstPasTreeContainer;
+begin
+  Result := ParseDoc('global_attribute',True);
+end;
+
 initialization
   RegisterTest('XSD parser',TTest_XsdParser.Suite);
   RegisterTest('WSDL parser',TTest_WsdlParser.Suite);

wst/trunk/ws_helper/ws_parser_imp.pas

@@ -1413,28 +1413,59 @@ var
     locAttObj : TPasProperty;
     locInternalEltName : string;
     locHasInternalName : boolean;
+    locIsRefElement : Boolean;
+    locTypeInternalName : string;
+    locTypeAddRef : Boolean;
   begin
+    locIsRefElement := False;
+    locTypeAddRef := True;
     locAttCursor := CreateAttributesCursor(AElement,cetRttiNode);
     locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer));
     locPartCursor.Reset();
+    if not locPartCursor.MoveNext() then begin
+      locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_ref)]),TDOMNodeRttiExposer));
+      locPartCursor.Reset();
       if not locPartCursor.MoveNext() then
         raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_MissingName);
+      locIsRefElement := True;
+    end;
     locName := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue;
+    if locIsRefElement then
+      locName := ExtractNameFromQName(locName);
     if IsStrEmpty(locName) then
       raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_EmptyName);
 
+    if locIsRefElement then begin
+      locTypeName := locName;
+    end else begin
       locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer));
       locPartCursor.Reset();
       if not locPartCursor.MoveNext() then
         raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_MissingType);
       locTypeName := ExtractNameFromQName((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue);
+    end;
     if IsStrEmpty(locTypeName) then
       raise EXsdInvalidDefinitionException.Create(SERR_InvalidAttributeDef_EmptyType);
     locType := FSymbols.FindElement(locTypeName) as TPasType;
-    if not Assigned(locType) then begin
+    if Assigned(locType) then begin
-      locType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locTypeName,Self.Module.InterfaceSection,visPublic,'',0));
+      if locIsRefElement then begin
-      Self.Module.InterfaceSection.Declarations.Add(locType);
+        locTypeInternalName := locTypeName;
-      Self.Module.InterfaceSection.Types.Add(locType);
+        locTypeInternalName := locTypeInternalName + '_Type';
+        locType.Name := locTypeInternalName;
+        FSymbols.RegisterExternalAlias(locType,locTypeName);
+      end;
+    end else begin
+      locTypeInternalName := ExtractIdentifier(locTypeName);
+      if locIsRefElement or AnsiSameText(locTypeInternalName,locInternalEltName) then begin
+        locTypeInternalName := locTypeInternalName + '_Type';
+      end;
+      if IsReservedKeyWord(locTypeInternalName) then begin
+        locTypeInternalName := '_' + locTypeInternalName;
+      end;
+      locType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locTypeInternalName,nil{Self.Module.InterfaceSection},visDefault,'',0));
+      locTypeAddRef := False;
+      if not AnsiSameText(locTypeInternalName,locTypeName) then
+        FSymbols.RegisterExternalAlias(locType,locTypeName);
     end;
     
     locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_use)]),TDOMNodeRttiExposer));
@@ -1458,7 +1489,8 @@ var
     locAttObj := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,locClassDef,visPublished,'',0));
     locClassDef.Members.Add(locAttObj);
     locAttObj.VarType := locType as TPasType;
-    locAttObj.VarType.AddRef();
+    if locTypeAddRef then
+      locType.AddRef();
     if locHasInternalName then
       FSymbols.RegisterExternalAlias(locAttObj,locName);
     FSymbols.SetPropertyAsAttribute(locAttObj,True);

wst/trunk/ws_helper/xsd_parser.pas

@@ -644,7 +644,9 @@ var
       typNd := FindNamedNode(crsSchemaChild,localTypeName);
     if not Assigned(typNd) then
       raise EXsdTypeNotFoundException.CreateFmt(SERR_TypeDefinitionNotFound,['1',AName]);
-    if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_element) then begin
+    if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_element) or
+       AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_attribute)
+    then begin
       crs := CreateCursorOn(CreateAttributesCursor(typNd,cetRttiNode),ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer));
       crs.Reset();
       if crs.MoveNext() then begin
@@ -923,10 +925,11 @@ begin
   if Assigned(FChildCursor) then begin
     crsSchemaChild := FChildCursor.Clone() as IObjectCursor;
     typFilterStr := Format(
-                      '%s or %s or %s',
+                      '%s or %s or %s or %s',
                       [ CreateQualifiedNameFilterStr(s_complexType,FXSShortNames),
                         CreateQualifiedNameFilterStr(s_simpleType,FXSShortNames),
-                        CreateQualifiedNameFilterStr(s_element,FXSShortNames)
+                        CreateQualifiedNameFilterStr(s_element,FXSShortNames),
+                        CreateQualifiedNameFilterStr(s_attribute,FXSShortNames)
                       ]
                     );
     crsSchemaChild := CreateCursorOn(crsSchemaChild,ParseFilter(typFilterStr,TDOMNodeRttiExposer));