Preparing Type name and Element disambiguation

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

wst/trunk/base_service_intf.pas

@@ -383,6 +383,7 @@ type
     class function ToStr(const ADate : TDateTime):string;overload;
     class function ToStr(const ADate : TDateTimeRec):string;overload;virtual;abstract;
     class function Parse(const ABuffer : string):TDateTimeRec;virtual;abstract;
+    class function ParseToUTC(const ABuffer : string):TDateTime;
 
     procedure Assign(Source: TPersistent); override;
     function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
@@ -3279,13 +3280,19 @@ begin
 end;
 
 function TTypeRegistry.IndexOf(Const ATypeInfo: PTypeInfo): Integer;
+var
+  i : Integer;
 begin
-  For Result := 0 To Pred(Count) Do Begin
+  for i := 0 to Pred(Count) do begin
-    If ( ATypeInfo^.Kind = Item[Result].DataType^.Kind ) And
+    if ( ATypeInfo = Item[i].DataType ) then begin
+      Result := i;
+      Exit;
+    end;
+    {If ( ATypeInfo^.Kind = Item[Result].DataType^.Kind ) And
        AnsiSameText(ATypeInfo^.Name,Item[Result].DataType^.Name)
     Then
-      Exit;
+      Exit;}
-  End;
+  end;
   Result := -1;
 end;
 
@@ -4733,10 +4740,12 @@ class procedure TSimpleContentHeaderBlock.Save(
 );
 var
   locSerializer : TObjectSerializer;
+  locOptionChanged : Boolean;
 begin
   locSerializer := TBaseComplexTypeRegistryItem(GetTypeRegistry().ItemByTypeInfo[ATypeInfo]).GetSerializer();
   if ( locSerializer <> nil ) then begin
-    if not ( osoDontDoBeginWrite in locSerializer.Options ) then
+    locOptionChanged := not ( osoDontDoBeginWrite in locSerializer.Options );
+    if locOptionChanged then
       locSerializer.Options := locSerializer.Options + [osoDontDoBeginWrite];
     AStore.BeginObject(AName,ATypeInfo);
     try
@@ -4745,6 +4754,8 @@ begin
       locSerializer.Save(AObject,AStore,AName,ATypeInfo);
     finally
       AStore.EndScope();
+      if locOptionChanged then
+        locSerializer.Options := locSerializer.Options - [osoDontDoBeginWrite];
     end;
   end else begin
     raise ETypeRegistryException.CreateFmt(SERR_NoSerializerFoThisType,[ATypeInfo^.Name])
@@ -5822,6 +5833,11 @@ begin
   Result := ToStr(locTemp);
 end;
 
+class function TBaseDateRemotable.ParseToUTC(const ABuffer : string) : TDateTime;
+begin
+  Result := NormalizeToUTC(Parse(ABuffer));
+end;
+
 { TComplexInt8SContentRemotable }
 
 class procedure TComplexInt8SContentRemotable.SaveValue(

wst/trunk/date_utils.pas

@@ -67,6 +67,10 @@ const
 
 type
   TXsdDateKind = ( xdkDateTime, xdkDate );
+  TValueCompareKind = (
+    vckEqual, vckLessThan, vckGreaterThan, vckNotEqual,
+    vckEqualOrLessThan, vckEqualOrGreaterThan
+  );
 
   function xsd_TryStrToDate(
     const AStr      : string;
@@ -123,6 +127,11 @@ type
   function ValueEquals(const AA,AB: TTimeRec) : Boolean; overload;
   function ValueEquals(const AA,AB: TDurationRec) : Boolean; overload;
 
+  function CompareValue(
+    const AA,AB        : TDateTimeRec;
+    const ACompareKind : TValueCompareKind
+  ) : Boolean;
+
 resourcestring
   SERR_InvalidDate = '"%s" is not a valid date.';
   SERR_InvalidTime = '"%s" is not a valid time.';
@@ -200,6 +209,27 @@ begin
             ( a.MinuteOffset = b.MinuteOffset );
 end;
 
+function CompareValue(
+  const AA,AB        : TDateTimeRec;
+  const ACompareKind : TValueCompareKind
+) : Boolean;
+var
+  locA, locB : TDateTime;
+begin
+  case ACompareKind of
+    vckEqual              : Result := ValueEquals(AA,AB);
+    vckLessThan           : Result := ( NormalizeToUTC(AA) < NormalizeToUTC(AB) );
+    vckGreaterThan        : Result := ( NormalizeToUTC(AA) > NormalizeToUTC(AB) );
+    vckNotEqual           : Result := not ValueEquals(AA,AB);
+    vckEqualOrLessThan    : Result := ValueEquals(AA,AB) or ( NormalizeToUTC(AA) < NormalizeToUTC(AB) );
+    vckEqualOrGreaterThan : Result := ValueEquals(AA,AB) or ( NormalizeToUTC(AA) > NormalizeToUTC(AB) );
+    else begin
+      Assert(False);  // To suppress the warning
+      Result := False;
+    end;
+  end;
+end;
+
 function xsd_TryStrToDate(
   const AStr      : string;
   out   ADate     : TDateTimeRec;

wst/trunk/ide/lazarus/wst_indy.lpk

@@ -8,7 +8,7 @@
       <Version Value="8"/>
       <PathDelim Value="\"/>
       <SearchPaths>
-        <OtherUnitFiles Value="..\..\"/>
+        <OtherUnitFiles Value="..\..\;$(LazarusDir)\others_package\indy-10.2.0.3\fpc\"/>
         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
       <Parsing>

wst/trunk/indy_http_protocol.pas

@@ -36,12 +36,15 @@ Type
     FConnection : TidHttp;
     FSoapAction: string;
     FContentType: string;
+  private
     function GetAddress: string;
+    function GetProtocolVersion : string;
     function GetProxyPassword: string;
     function GetProxyPort: Integer;
     function GetProxyServer: string;
     function GetProxyUsername: string;
     procedure SetAddress(const AValue: string);
+    procedure SetProtocolVersion(const AValue : string);
     procedure SetProxyPassword(const AValue: string);
     procedure SetProxyPort(const AValue: Integer);
     procedure SetProxyServer(const AValue: string);
@@ -60,12 +63,36 @@ Type
     property ProxyPassword : string read GetProxyPassword write SetProxyPassword;
     property SoapAction : string read FSoapAction write FSoapAction;
     property Format : string read FFormat write FFormat;
+    property ProtocolVersion : string read GetProtocolVersion write SetProtocolVersion;
   End;
 {$M+}
 
   procedure INDY_RegisterHTTP_Transport();
 
 implementation
+uses
+  wst_consts;
+
+const
+  ProtocolVersionMAP : array[TIdHTTPProtocolVersion] of string = ('1.0', '1.1');
+
+function TryStrToProtocolVersion(
+  const AStr : string;
+  out   ARes : TIdHTTPProtocolVersion
+) : Boolean;
+var
+  i : TIdHTTPProtocolVersion;
+begin
+  for i := Low(TIdHTTPProtocolVersion) to High(TIdHTTPProtocolVersion) do begin
+    if ( AStr = ProtocolVersionMAP[i] ) then begin
+      ARes := i;
+      Result := True;
+      Exit;
+    end;
+  end;
+  Result := False;
+end;
+
 
 { THTTPTransport }
 
@@ -74,6 +101,11 @@ begin
   Result := FConnection.Request.URL;
 end;
 
+function THTTPTransport.GetProtocolVersion : string;
+begin
+  Result := ProtocolVersionMAP[FConnection.ProtocolVersion];
+end;
+
 function THTTPTransport.GetProxyPassword: string;
 begin
   Result := FConnection.ProxyParams.ProxyPassword;
@@ -99,6 +131,17 @@ begin
   FConnection.Request.URL := AValue;
 end;
 
+procedure THTTPTransport.SetProtocolVersion(const AValue : string);
+var
+  locValue : TIdHTTPProtocolVersion;
+begin
+  if not TryStrToProtocolVersion(AValue,locValue) then
+    raise ETransportExecption.CreateFmt(SERR_InvalidPropertyValue,['ProtocolVersion',AValue]);
+  FConnection.ProtocolVersion := locValue;
+  if not ( hoKeepOrigProtocol in FConnection.HTTPOptions ) then
+    FConnection.HTTPOptions := FConnection.HTTPOptions + [hoKeepOrigProtocol];
+end;
+
 procedure THTTPTransport.SetProxyPassword(const AValue: string);
 begin
   FConnection.ProxyParams.ProxyPassword := AValue;
@@ -151,8 +194,11 @@ begin
     FConnection.ProxyParams.BasicAuthentication := True;
   end;
   FConnection.Request.CustomHeaders.Clear();
-  FConnection.Request.CustomHeaders.Values['soapAction'] := SoapAction;
+  FConnection.Request.CustomHeaders.Values['SOAPAction'] := SoapAction;
   FConnection.Request.ContentType := ContentType;
+{$IFDEF WST_DBG}
+  TMemoryStream(ARequest).SaveToFile('request.log');
+{$ENDIF WST_DBG}
   FConnection.Post(Address,ARequest, AResponse);
   {$IFDEF WST_DBG}
   i := AResponse.Size;

wst/trunk/tests/test_suite/test_generators_runtime.pas

@@ -310,10 +310,10 @@ begin
       RegisterExternalPropertyName('__FIELDS__','fieldSmallint;fieldWord;fieldString');
     end;
 {$IFNDEF WST_RECORD_RTTI}
-    typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(TypeInfo(TTestSmallRecord)),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__')));
+    typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(TypeInfo(TTestSmallRecord)),typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__')));
 {$ENDIF WST_RECORD_RTTI}
 {$IFDEF WST_RECORD_RTTI}
-    typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(__TTestSmallRecord_TYPEINFO_FUNC__()),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__')));
+    typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(__TTestSmallRecord_TYPEINFO_FUNC__()),typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__')));
 {$ENDIF WST_RECORD_RTTI}
     (typeReg.ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetObject(FIELDS_STRING) as TRecordRttiDataObject).GetField('fieldWord')^.IsAttribute := True;
     handlerReg := CreateWsdlTypeHandlerRegistry(typeReg);

wst/trunk/ws_helper/pascal_parser_intf.pas

@@ -20,6 +20,7 @@ uses
   pparser, pastree;
 
 const
+  sEMBEDDED_TYPE = '_E_T_';
   sEXTERNAL_NAME = '_E_N_';
   sATTRIBUTE = '_ATTRIBUTE_';
   sARRAY_ITEM_NAME = 'ARRAY_ITEM_NAME';
@@ -409,6 +410,7 @@ begin
     AddSystemSymbol(Result,AContainer);
     AddClassDef(Result,'TBaseRemotable','',TPasNativeClassType);
       AddClassDef(Result,'TAbstractSimpleRemotable','TBaseRemotable',TPasNativeClassType);
+        AContainer.RegisterExternalAlias(AddClassDef(Result,'schema_Type','TAbstractSimpleRemotable'),'schema');
         AContainer.RegisterExternalAlias(AddClassDef(Result,'TDateRemotable','TAbstractSimpleRemotable'),'date');
         AContainer.RegisterExternalAlias(AddClassDef(Result,'TDateTimeRemotable','TAbstractSimpleRemotable'),'dateTime');
 {$IFDEF WST_HAS_TDURATIONREMOTABLE}

wst/trunk/ws_helper/ws_parser_imp.pas

@@ -51,6 +51,8 @@ type
     ) : TPasElement;{$IFDEF USE_INLINE}inline;{$ENDIF}
     function FindElementWithHint(const AName, AHint : string; const ASpace : TSearchSpace) : TPasElement;
     function ExtractTypeHint(AElement : TDOMNode) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
+    procedure SetAsEmbeddedType(AType : TPasType);
+    function IsEmbeddedType(AType : TPasType) : Boolean;
 {$IFDEF WST_HANDLE_DOC}
     procedure ParseDocumentation(AType : TPasType);
 {$ENDIF WST_HANDLE_DOC}
@@ -353,6 +355,16 @@ begin
     Result := '';
 end;
 
+procedure TAbstractTypeParser.SetAsEmbeddedType(AType : TPasType); 
+begin
+  FSymbols.Properties.SetValue(AType,sEMBEDDED_TYPE,'1');
+end;
+
+function TAbstractTypeParser.IsEmbeddedType(AType : TPasType) : Boolean; 
+begin
+  Result := ( FSymbols.Properties.GetValue(AType,sEMBEDDED_TYPE) = '1' );
+end;
+
 {$IFDEF WST_HANDLE_DOC}
 procedure TAbstractTypeParser.ParseDocumentation(AType : TPasType);
 var
@@ -1049,10 +1061,10 @@ begin
   internalName := ExtractIdentifier(ATypeName);
   hasInternalName := IsReservedKeyWord(internalName) or
                      ( not IsValidIdent(internalName) ) or
-                     //( FSymbols.IndexOf(internalName) <> -1 ) or
+                     ( FSymbols.FindElementInModule(internalName,Self.Module,[elkName]) <> nil ) or
                      ( not AnsiSameText(internalName,ATypeName) );
   if hasInternalName then begin
-    internalName := Format('_%s',[internalName]);
+    internalName := Format('%s_Type',[internalName]);
   end;
 
   if ( pthDeriveFromSoapArray in FHints ) or
@@ -1379,7 +1391,8 @@ begin
   if Assigned(locSym) then begin
     if not locSym.InheritsFrom(TPasType) then
       raise EXsdParserException.CreateFmt('Symbol found in the symbol table but is not a type definition : %s.',[FTypeName]);
-    locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef);
+    locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef) or
+                   ( IsEmbeddedType(TPasType(locSym)) <> FEmbededDef );
     if not locContinue then;
       Result := locSym as TPasType;
   end;

wst/trunk/ws_helper/wsdl_parser.pas

@@ -75,7 +75,11 @@ type
       const ASoapBindingStyle : string
     ) : TPasProcedure;
     function GetParser(const ANamespace : string) : IXsdPaser;
-    function ParseType(const AName : string; const AHint : string = '') : TPasType;
+    function ParseType(
+      const AName : string; 
+      const AHint : string = '';
+      const ATypeOrElement : string = ''
+    ) : TPasType;
     procedure ParseTypes();
   protected
     function GetXsShortNames() : TStrings;
@@ -300,6 +304,7 @@ procedure TWsdlParser.Execute(const AMode: TParserMode; const AModuleName: strin
     schmNode, tmpNode : TDOMNode;
     s : string;
     typeList : TList;
+    locXsdParser : IXsdPaser;
   begin
     if Assigned(FSchemaCursor) then begin
       FSchemaCursor.Reset();
@@ -323,7 +328,8 @@ procedure TWsdlParser.Execute(const AMode: TParserMode; const AModuleName: strin
                 tmpNode := FindNamedNode(typeCursor,FSymbols.GetExternalName(sym));
                 if Assigned(tmpNode) then begin
                   //symNew := ParseType(FSymbols.GetExternalName(sym));
-                  symNew := GetParser(schmNode.Attributes.GetNamedItem(s_targetNamespace).NodeValue).ParseType(FSymbols.GetExternalName(sym));
+                  locXsdParser := GetParser(schmNode.Attributes.GetNamedItem(s_targetNamespace).NodeValue);
+                  symNew := locXsdParser.ParseType(FSymbols.GetExternalName(sym),tmpNode);
                   //symNew := ParseType(tmpNode.Attributes.GetNamedItem(s_name).NodeValue);
                   if ( sym <> symNew ) then begin
                     FModule.InterfaceSection.Declarations.Extract(sym);
@@ -460,7 +466,7 @@ function TWsdlParser.ParseOperation(
   function GetDataType(const AName, ATypeOrElement : string; const ATypeHint : string = ''):TPasType;
   begin
     try
-      Result := ParseType(AName,ATypeHint);
+      Result := ParseType(AName,ATypeHint,ATypeOrElement);
     except
       on e : Exception do begin
         DoOnMessage(mtError, e.Message + ' ' + AName + ' ' + ATypeOrElement);
@@ -578,7 +584,9 @@ function TWsdlParser.ParseOperation(
                   prmName := ExtractNameFromQName(prmTypeName);
                 end;
                 prmInternameName := Trim(prmName);
-                if AnsiSameText(prmInternameName,tmpMthd.Name) then begin
+                if AnsiSameText(prmInternameName,tmpMthd.Name) or 
+                   AnsiSameText(prmInternameName,ExtractNameFromQName(prmTypeName)) 
+                then begin
                   prmInternameName := prmInternameName + 'Param';
                 end;
                 prmHasInternameName := IsReservedKeyWord(prmInternameName) or
@@ -1176,11 +1184,16 @@ begin
   end;
 end;
 
-function TWsdlParser.ParseType(const AName : string; const AHint : string) : TPasType;
+function TWsdlParser.ParseType(
+  const AName : string; 
+  const AHint : string;
+  const ATypeOrElement : string
+) : TPasType;
 var
   localName, spaceShort, spaceLong : string;
   locPrs : IXsdPaser;
   xsdModule : TPasModule;
+  locTypeKind : string;
 begin
   ExplodeQName(AName,localName,spaceShort);
   if ( FXSShortNames.IndexOf(spaceShort) >= 0 ) then begin
@@ -1196,7 +1209,11 @@ begin
     if not FindNameSpace(spaceShort,spaceLong) then
       raise EXsdParserAssertException.CreateFmt('Unable to resolve the namespace : "%s".',[spaceShort]);
     locPrs := GetParser(spaceLong);
-    Result := locPrs.ParseType(AName);
+    if ( ATypeOrElement = s_element ) then
+      locTypeKind := s_element
+    else
+      locTypeKind := '';
+    Result := locPrs.ParseType(AName,locTypeKind);
   end;
 end;
 

wst/trunk/ws_helper/xsd_parser.pas

@@ -55,7 +55,14 @@ type
 
   IXsdPaser = interface
     ['{F0CEC726-A068-4CCC-B1E7-D31F018415B2}']
-    function ParseType(const AName : string) : TPasType;
+    function ParseType(
+      const AName,
+            ATypeKind : string { ATypeKind "ComplexType", "SimpleType", "Element" }
+    ) : TPasType; overload;
+    function ParseType(
+      const AName     : string;
+      const ATypeNode : TDOMNode
+    ) : TPasType; overload;
     procedure ParseTypes();
     procedure SetNotifier(ANotifier : TOnParserMessage);
   end;
@@ -90,6 +97,10 @@ type
     function FindShortNamesForNameSpaceLocal(const ANameSpace : string) : TStrings;
     function FindShortNamesForNameSpace(const ANameSpace : string) : TStrings;
     procedure SetNotifier(ANotifier : TOnParserMessage);
+    function InternalParseType(
+      const AName : string;
+      const ATypeNode : TDOMNode
+    ) : TPasType;
   public
     constructor Create(
       ADoc           : TXMLDocument;
@@ -98,7 +109,15 @@ type
       AParentContext : IParserContext
     );
     destructor Destroy();override;
-    function ParseType(const AName : string) : TPasType;
+    function ParseType(
+      const AName,
+            ATypeKind : string { ATypeKind "ComplexType", "SimpleType", "Element" }
+    ) : TPasType; overload;
+    function ParseType(
+      const AName     : string;
+      const ATypeNode : TDOMNode
+    ) : TPasType; overload;
+
     procedure ParseTypes();
 
     function GetTargetNameSpace() : string;
@@ -296,7 +315,23 @@ begin
   Result := FXSShortNames;
 end;
 
-function TCustomXsdSchemaParser.ParseType(const AName: string): TPasType;
+function TCustomXsdSchemaParser.ParseType(const AName, ATypeKind : string): TPasType;
+begin
+  Result := InternalParseType(AName,nil);
+end;
+
+function TCustomXsdSchemaParser.ParseType(
+  const AName : string;  
+  const ATypeNode : TDOMNode
+) : TPasType; 
+begin
+  Result := InternalParseType(AName,ATypeNode);
+end;
+
+function TCustomXsdSchemaParser.InternalParseType(
+  const AName : string;
+  const ATypeNode : TDOMNode
+): TPasType;
 var
   crsSchemaChild : IObjectCursor;
   typNd : TDOMNode;
@@ -324,6 +359,9 @@ var
   begin
     ASimpleTypeAlias := nil;
     Result := True;
+    if ( ATypeNode <> nil ) then
+      typNd := ATypeNode
+    else
       typNd := FindNamedNode(crsSchemaChild,localTypeName);
     if not Assigned(typNd) then
       raise EXsdTypeNotFoundException.CreateFmt('Type definition not found 1 : "%s"',[AName]);
@@ -432,6 +470,7 @@ var
   sct : TPasSection;
   shortNameSpace, longNameSpace : string;
   typeModule : TPasModule;
+  locTypeNodeFound : Boolean;
 begin
   sct := nil;
   DoOnMessage(mtInfo, Format('Parsing "%s" ...',[AName]));
@@ -449,6 +488,14 @@ begin
     if ( typeModule = nil ) then
       raise EXsdTypeNotFoundException.Create(AName);
     Result := SymbolTable.FindElementInModule(localTypeName,typeModule) as TPasType;
+    Init();
+    locTypeNodeFound := FindTypeNode(aliasType);
+    if ( Result <> nil ) and ( typeModule = FModule ) and
+       ( not Result.InheritsFrom(TPasUnresolvedTypeRef) )
+    then begin                              
+      if locTypeNodeFound and ( embededType <> ( SymbolTable.Properties.GetValue(Result,sEMBEDDED_TYPE) = '1' ) ) then
+        Result := nil;
+    end;
     if ( ( Result = nil ) or Result.InheritsFrom(TPasUnresolvedTypeRef) ) and
        ( typeModule = FModule )
     then begin
@@ -456,7 +503,7 @@ begin
       frwType := Result;
       Result := nil;
       Init();
-      if FindTypeNode(aliasType) then begin
+      if locTypeNodeFound {FindTypeNode(aliasType)} then begin
         if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_complexType) then begin
           Result := ParseComplexType();
         end else if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_simpleType) then begin
@@ -520,8 +567,9 @@ begin
         typTmpCrs := CreateCursorOn(typTmpCrs,ParseFilter(Format('%s=%s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer));
         typTmpCrs.Reset();
         if typTmpCrs.MoveNext() then begin
-          ParseType(
+          InternalParseType(
-            (typTmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue
+            (typTmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue,
+            typNode
           );
         end;
       end;