* Remove duplicated class' properties(Complex type restriction case)

* Add the "_" prefix or the "_Type" suffix only when necessary
* Search module by namespace if a namespace is provided (FindModule)
* Parse schema's imported documents

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

wst/trunk/ws_helper/pascal_parser_intf.pas

@@ -238,7 +238,15 @@ type
   function FindMember(AClass : TPasRecordType; const AName : string) : TPasElement ; overload;
   function GetElementCount(AList : TList2; AElementClass : TPTreeElement):Integer ;
   
-  function GetUltimeType(AType : TPasType) : TPasType;
+  function GetUltimeType(AType : TPasType) : TPasType;overload;
+  function GetUltimeType(
+    AType      : TPasType;
+    AContainer : TwstPasTreeContainer
+  ) : TPasType;overload;
+  function FindActualType(
+    AType      : TPasType;
+    AContainer : TwstPasTreeContainer
+  ) : TPasType;
   function MakeInternalSymbolNameFrom(const AName : string) : string ;
 
 
@@ -514,6 +522,31 @@ begin
   end;
 end;
 
+function GetUltimeType(
+  AType      : TPasType;
+  AContainer : TwstPasTreeContainer
+) : TPasType;
+var
+  e : TPasElement;
+begin
+  Result := AType;
+  if (Result <> nil) then begin
+    while True do begin
+      if Result.InheritsFrom(TPasUnresolvedTypeRef) then begin
+        e := AContainer.FindElement(AContainer.GetExternalName(Result));
+        if (e <> nil) and e.InheritsFrom(TPasType) then
+          Result := TPasType(e);
+      end;
+      if Result.InheritsFrom(TPasAliasType) and
+         (TPasAliasType(Result).DestType <> nil)
+      then
+        Result := TPasAliasType(Result).DestType
+      else
+        Break;
+    end;
+  end;
+end;
+
 function GetUltimeType(AType : TPasType) : TPasType;
 begin
   Result := AType;
@@ -526,6 +559,21 @@ begin
   end;
 end;
 
+function FindActualType(
+  AType      : TPasType;
+  AContainer : TwstPasTreeContainer
+) : TPasType;
+var
+  e : TPasElement;
+begin
+  Result := AType;
+  if Result.InheritsFrom(TPasUnresolvedTypeRef) then begin
+    e := AContainer.FindElement(AContainer.GetExternalName(Result));
+    if (e <> nil) and e.InheritsFrom(TPasType) then
+      Result := TPasType(e);
+  end;
+end;
+
 function GetElementCount(AList : TList2; AElementClass : TPTreeElement):Integer ;
 var
   i : Integer;
@@ -867,13 +915,25 @@ function TwstPasTreeContainer.FindModule(const AName: String): TPasModule;
 var
   i , c : Integer;
   mdl : TList2;
+  s : string;
 begin
   Result := nil;
+  s := ExtractIdentifier(AName);
   mdl := Package.Modules;
   c := mdl.Count;
+  if (s = AName) then begin
     for i := 0 to Pred(c) do begin
       if SameName(TPasModule(mdl[i]),AName) then begin
         Result := TPasModule(mdl[i]);
+        Break;
+      end;
+    end;
+  end else begin
+    for i := 0 to Pred(c) do begin
+      if (GetExternalName(TPasModule(mdl[i])) = AName) then begin
+        Result := TPasModule(mdl[i]);
+        Break;
+      end;
     end;
   end;
 end;

wst/trunk/ws_helper/ws_parser_imp.pas

@@ -1209,11 +1209,11 @@ begin
   internalName := ExtractIdentifier(ATypeName);
   hasInternalName := IsReservedKeyWord(internalName) or
                      ( not IsValidIdent(internalName) ) or
-                     ( FSymbols.FindElementInModule(internalName,Self.Module,[elkName]) <> nil ) or
+                     ( FSymbols.FindElementInModule(internalName,Self.Module,[elkName]) <> nil );
-                     ( not AnsiSameText(internalName,ATypeName) );
   if hasInternalName then begin
     internalName := Format('%s_Type',[internalName]);
   end;
+  hasInternalName := hasInternalName or not(AnsiSameText(internalName,ATypeName));
 
   if ( pthDeriveFromSoapArray in FHints ) or
      ( ( FDerivationMode = dmRestriction ) and FSymbols.SameName(FBaseType,s_array) )
@@ -1354,6 +1354,9 @@ begin
           FreeAndNil(tmpClassDef);
         end;
 
+        if (FDerivationMode = dmRestriction) and Result.InheritsFrom(TPasClassType) then
+          Context.AddTypeToCheck(Result);
+
         if ( locAnyNode <> nil ) or ( locAnyAttNode <> nil ) then
           ProcessXsdAnyDeclarations(locAnyNode,locAnyAttNode,Result);
       except
@@ -1807,7 +1810,7 @@ begin  // todo : implement TSimpleTypeParser.ParseOtherContent
     if ( tmpElement <> nil ) and ( not tmpElement.InheritsFrom(TPasUnresolvedTypeRef) ) then
       hasIntrnName := True;
   end;
-  if hasIntrnName then
+  if IsReservedKeyWord(intrName){hasIntrnName} then
     intrName := '_' + intrName;
   Result := TPasTypeAliasType(FSymbols.CreateElement(TPasTypeAliasType,intrName,Self.Module.InterfaceSection,visDefault,'',0));
   if ( intrName <> FTypeName ) then

wst/trunk/ws_helper/wsdl_parser.pas

@@ -60,6 +60,7 @@ type
     FSchemaCursor : IObjectCursor;
     FOnMessage: TOnParserMessage;
     FSimpleOptions : TParserOptions;
+    FCheckedTypes : TList2;
     FIncludeList : TStringList;
   private
     procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string);
@@ -98,6 +99,7 @@ type
     procedure SetDocumentLocator(ALocator : IDocumentLocator);
     function GetSimpleOptions() : TParserOptions;
     procedure SetSimpleOptions(const AValue : TParserOptions);
+    procedure AddTypeToCheck(AType : TPasType);
     procedure AddIncludedDoc(ADocLocation : string);
     function IsIncludedDoc(ADocLocation : string) : Boolean;
   public
@@ -183,6 +185,7 @@ begin
   FXsdParsers.Sorted := True;
 
   FSymbols := ASymbols;
+  FCheckedTypes := TList2.Create();
 end;
 
 function TWsdlParser.CreateWsdlNameFilter(const AName: WideString): IObjectFilter;
@@ -206,6 +209,7 @@ destructor TWsdlParser.Destroy();
   end;
   
 begin
+  FCheckedTypes.Free();
   FreeAndNil(FIncludeList);
   FreeList(FXsdParsers);
   FreeList(FNameSpaceList);
@@ -315,6 +319,16 @@ begin
     FSimpleOptions := AValue;
 end;
 
+procedure TWsdlParser.AddTypeToCheck(AType: TPasType);
+begin
+  if (AType = nil) then
+    exit;
+  if (FCheckedTypes = nil) then
+    FCheckedTypes := TList2.Create();
+  if (FCheckedTypes.IndexOf(AType) = -1) then
+    FCheckedTypes.Add(AType);
+end;
+
 procedure TWsdlParser.AddIncludedDoc(ADocLocation : string);
 begin
   if (FIncludeList = nil) then
@@ -462,6 +476,8 @@ begin
     SymbolTable.SetCurrentModule(FModule);
     ExtractNameSpace();
     FixUsesList();
+    if (FCheckedTypes.Count > 0) then
+      CheckDuplicatedProperties(FCheckedTypes,SymbolTable);
   finally
     FSymbols.DefaultSearchNameKinds := locOldNameKinds;
   end;

wst/trunk/ws_helper/xsd_parser.pas

@@ -72,6 +72,7 @@ type
     procedure SetDocumentLocator(ALocator : IDocumentLocator);
     function GetSimpleOptions() : TParserOptions;
     procedure SetSimpleOptions(const AValue : TParserOptions);
+    procedure AddTypeToCheck(AType : TPasType);
 
     procedure AddIncludedDoc(ADocLocation : string);
     function IsIncludedDoc(ADocLocation : string) : Boolean;
@@ -110,6 +111,7 @@ type
     FOnMessage: TOnParserMessage;
     FDocumentLocator : IDocumentLocator;
     FSimpleOptions : TParserOptions;
+    FCheckedTypes : TList2;
     FImportParsed : Boolean;
     FXsdParsers : TStringList;
     FIncludeList : TStringList;
@@ -121,6 +123,7 @@ type
   private
     function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode;
     function GetParentContext() : IParserContext;{$IFDEF USE_INLINE}inline;{$ENDIF}
+    function HasParentContext() : Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
     procedure Prepare(const AMustSucceed : Boolean);
     function FindElement(const AName: String) : TPasElement; overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
     function FindElement(const AName: String; const ANameKinds : TElementNameKinds) : TPasElement; overload;{$IFDEF USE_INLINE}inline;{$ENDIF}
@@ -134,6 +137,7 @@ type
     procedure SetDocumentLocator(ALocator : IDocumentLocator);
     function GetSimpleOptions() : TParserOptions;
     procedure SetSimpleOptions(const AValue : TParserOptions);
+    procedure AddTypeToCheck(AType : TPasType);
     procedure AddIncludedDoc(ADocLocation : string);
     function IsIncludedDoc(ADocLocation : string) : Boolean;
 
@@ -185,6 +189,11 @@ type
     );
   end;
 
+  procedure CheckDuplicatedProperties(
+    AClassList   : TList2;
+    ASymbolTable : TwstPasTreeContainer
+  );
+
 implementation
 uses ws_parser_imp, dom_cursors, parserutils, xsd_consts, wst_consts
 {$IFDEF FPC}
@@ -200,6 +209,50 @@ begin
     Result := ANode.NodeValue;
 end;
 
+procedure CheckDuplicatedProperties(
+  AClassList   : TList2;
+  ASymbolTable : TwstPasTreeContainer
+);
+var
+  i, k : Integer;
+  locItem : TPasClassType;
+  locAncestor : TPasType;
+  e : TPasElement;
+begin
+  for i := 0 to AClassList.Count-1 do begin
+    locItem := TPasClassType(AClassList[i]);
+    if (locItem.Members.Count = 0) then
+      Continue;
+    locAncestor := locItem.AncestorType;
+    while (locAncestor <> nil) do begin
+      if locAncestor.InheritsFrom(TPasUnresolvedTypeRef) then begin
+        e := ASymbolTable.FindElement(ASymbolTable.GetExternalName(locAncestor));
+        if (e = nil) or not(e.InheritsFrom(TPasType)) then
+          Break;
+        locAncestor := e as TPasType;
+      end;
+      if not locAncestor.InheritsFrom(TPasClassType) then
+        Break;
+      if (TPasClassType(locAncestor).Members.Count = 0) then
+        Break;
+      k := 0;
+      while (k < locItem.Members.Count) do begin
+        e := TPasElement(locItem.Members[k]);
+        if not e.InheritsFrom(TPasProperty) then
+          Continue;
+        if (TPasClassType(locAncestor).FindMember(TPasProperty,e.Name) <> nil) then begin
+          locItem.Members.Delete(k);
+          e.Release();
+          Continue;
+        end;
+        k := k + 1;
+      end;
+      locAncestor := TPasClassType(locAncestor).AncestorType;
+    end;
+  end;
+end;
+
+
 { TCustomXsdSchemaParser }
 
 constructor TCustomXsdSchemaParser.Create(
@@ -252,6 +305,7 @@ begin
   FreeAndNil(FIncludeList);
   FreeList(FNameSpaceList);
   FreeList(FXsdParsers);
+  FCheckedTypes.Free();
   inherited;
 end;
 
@@ -530,6 +584,20 @@ begin
     FSimpleOptions := AValue;
 end;
 
+procedure TCustomXsdSchemaParser.AddTypeToCheck(AType: TPasType);
+begin
+  if (AType = nil) then
+    exit;
+  if HasParentContext() then begin
+    GetParentContext().AddTypeToCheck(AType);
+    exit;
+  end;
+  if (FCheckedTypes = nil) then
+    FCheckedTypes := TList2.Create();
+  if (FCheckedTypes.IndexOf(AType) = -1) then
+    FCheckedTypes.Add(AType);
+end;
+
 procedure TCustomXsdSchemaParser.AddIncludedDoc(ADocLocation : string);
 begin
   if (poParsingIncludeSchema in FSimpleOptions) then begin
@@ -572,6 +640,11 @@ begin
   Result := IParserContext(FParentContext);
 end;
 
+function TCustomXsdSchemaParser.HasParentContext() : Boolean;
+begin
+  Result := (FParentContext <> nil);
+end;
+
 function TCustomXsdSchemaParser.GetSymbolTable() : TwstPasTreeContainer;
 begin
   Result := FSymbols;
@@ -716,16 +789,18 @@ var
 
   function CreateTypeAlias(const ABase : TPasType): TPasType;
   var
-    hasInternameName : Boolean;
+    hasInterName : Boolean;
-    internameName : string;
+    baseName,internalName : string;
   begin
-    internameName := ExtractNameFromQName(AName);
+    baseName := ExtractNameFromQName(AName);
-    hasInternameName := IsReservedKeyWord(internameName) or
+    internalName := ExtractIdentifier(baseName);
-                           ( not IsValidIdent(internameName) );
+    hasInterName := IsReservedKeyWord(internalName) or
-    if hasInternameName then begin
+                    ( not IsValidIdent(internalName) );
-      internameName := '_' + internameName;
+    if hasInterName then begin
+      internalName := '_' + internalName;
     end;
-    Result := TPasType(SymbolTable.CreateElement(TPasAliasType,internameName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0));
+    Result := TPasType(SymbolTable.CreateElement(TPasAliasType,internalName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0));
+    SymbolTable.RegisterExternalAlias(Result,baseName);
     TPasAliasType(Result).DestType := ABase;
     ABase.AddRef();
   end;
@@ -733,17 +808,18 @@ var
   function CreateUnresolveType(): TPasType;
   var
     hasInternameName : Boolean;
-    internameName : string;
+    internameName, baseName : string;
   begin
-    internameName := ExtractNameFromQName(AName);
+    baseName := ExtractNameFromQName(AName);
-    hasInternameName := IsReservedKeyWord(internameName) or
+    internameName := ExtractIdentifier(baseName);
-                           ( not IsValidIdent(internameName) );
+    hasInternameName := IsReservedKeyWord(baseName) or
+                        (not IsValidIdent(internameName));
     if hasInternameName then begin
       internameName := '_' + internameName;
     end;
     Result := TPasUnresolvedTypeRef(SymbolTable.CreateElement(TPasUnresolvedTypeRef,internameName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0));
-    if not AnsiSameText(internameName,AName) then
+    if not AnsiSameText(internameName,baseName) then
-      SymbolTable.RegisterExternalAlias(Result,AName);
+      SymbolTable.RegisterExternalAlias(Result,baseName);
   end;
 
 var
@@ -891,6 +967,7 @@ begin
                 locModule := locContext.GetTargetModule();
                 if (locModule <> FModule) and (locUsesList.IndexOf(locModule) = -1) then begin
                   s := ChangeFileExt(ExtractFileName(locFileName),'');
+                  s := ExtractIdentifier(s);
                   i := 1;
                   locName := s;
                   while (FSymbols.FindModule(locName) <> nil) do begin
@@ -921,6 +998,7 @@ var
   typNode : TDOMNode;
 begin
   Prepare(True);
+  ParseImportDocuments();
   ParseIncludeDocuments();
   if Assigned(FChildCursor) then begin
     crsSchemaChild := FChildCursor.Clone() as IObjectCursor;
@@ -950,6 +1028,8 @@ begin
       end;
     end;
   end;
+  if (FCheckedTypes <> nil) and (FCheckedTypes.Count > 0) then
+    CheckDuplicatedProperties(FCheckedTypes,FSymbols);
 end;
 
 procedure TCustomXsdSchemaParser.Prepare(const AMustSucceed : Boolean);