diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index 89553165e..a17943a4d 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -627,6 +627,51 @@ type property mustUnderstand : Integer read FmustUnderstand write SetmustUnderstand stored HasmustUnderstand; end; + { TObjectCollectionRemotable + An implementation for array handling. The array items are "owned" by + this class instance, so one has not to free them. + } + TObjectCollectionRemotable = class(TAbstractComplexRemotable) + private + FList : TObjectList; + protected + function GetItem(AIndex : PtrInt) : TBaseRemotable;{$IFDEF USE_INLINE}inline;{$ENDIF} + class function GetItemName():string;virtual; + class function GetStyle():TArrayStyle;virtual; + function GetLength : PtrInt; + public + class procedure Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : string; + const ATypeInfo : PTypeInfo + );override; + class procedure Load( + var AObject : TObject; + AStore : IFormatterBase; + var AName : string; + const ATypeInfo : PTypeInfo + );override; + class function GetItemClass():TBaseRemotableClass;virtual;abstract; + class function GetItemTypeInfo():PTypeInfo;{$IFDEF USE_INLINE}inline;{$ENDIF} + + constructor Create();override; + destructor Destroy();override; + procedure Assign(Source: TPersistent); override; + function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; + + function Add(): TBaseRemotable;{$IFDEF USE_INLINE}inline;{$ENDIF} + function AddAt(const APosition : PtrInt): TBaseRemotable;{$IFDEF USE_INLINE}inline;{$ENDIF} + function Extract(const AIndex : PtrInt): TBaseRemotable;{$IFDEF USE_INLINE}inline;{$ENDIF} + procedure Delete(const AIndex : PtrInt);{$IFDEF USE_INLINE}inline;{$ENDIF} + procedure Exchange(const Index1,Index2 : PtrInt);{$IFDEF USE_INLINE}inline;{$ENDIF} + procedure Clear();{$IFDEF USE_INLINE}inline;{$ENDIF} + function IndexOf(AObject : TBaseRemotable) : PtrInt;{$IFDEF USE_INLINE}inline;{$ENDIF} + + property Item[AIndex:PtrInt] : TBaseRemotable read GetItem;default; + property Length : PtrInt read GetLength; + end; + TBaseArrayRemotableClass = class of TBaseArrayRemotable; { TBaseArrayRemotable } @@ -2940,6 +2985,254 @@ begin end; end; +{ TObjectCollectionRemotable } + +function TObjectCollectionRemotable.GetItem(AIndex : PtrInt) : TBaseRemotable; +begin + Result := TBaseRemotable(FList[AIndex]); +end; + +function TObjectCollectionRemotable.GetLength : PtrInt; +begin + Result := FList.Count; +end; + +class function TObjectCollectionRemotable.GetItemName() : string; +var + tri : TTypeRegistryItem; +begin + tri := GetTypeRegistry().Find(PTypeInfo(Self.ClassInfo),False); + if Assigned(tri) then + Result := Trim(tri.GetExternalPropertyName(sARRAY_ITEM)); + if ( System.Length(Result) = 0 ) then + Result := sARRAY_ITEM; +end; + +class function TObjectCollectionRemotable.GetStyle() : TArrayStyle; +var + tri : TTypeRegistryItem; +begin + tri := GetTypeRegistry().Find(PTypeInfo(Self.ClassInfo),False); + if Assigned(tri) and AnsiSameText(sEmbedded,Trim(tri.GetExternalPropertyName(sARRAY_STYLE))) then begin + Result := asEmbeded; + end else begin + Result := asScoped; + end; +end; + +class procedure TObjectCollectionRemotable.Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : string; + const ATypeInfo : PTypeInfo +); +Var + itmTypInfo : PTypeInfo; + i,j : Integer; + nativObj : TObjectCollectionRemotable; + itm : TObject; + itmName : string; + styl : TArrayStyle; +begin + if Assigned(AObject) then begin + Assert(AObject.InheritsFrom(TObjectCollectionRemotable)); + nativObj := AObject as TObjectCollectionRemotable; + j := nativObj.Length; + end else begin + j := 0; + end; + itmTypInfo := PTypeInfo(GetItemClass().ClassInfo); + styl := GetStyle(); + AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,Pred(j)],styl); + try + if ( styl = asScoped ) then begin + itmName := GetItemName(); + end else begin + itmName := AName; + end; + for i := 0 to Pred(j) do begin + itm := nativObj.Item[i]; + AStore.Put(itmName,itmTypInfo,itm); + end; + finally + AStore.EndScope(); + end; +end; + +class procedure TObjectCollectionRemotable.Load( + var AObject : TObject; + AStore : IFormatterBase; + var AName : String; + const ATypeInfo : PTypeInfo +); +Var + i, len : Integer; + nativObj : TObjectCollectionRemotable; + s : string; + itmTypInfo : PTypeInfo; + itm : TBaseRemotable; + itmName : string; + styl : TArrayStyle; +begin + styl := GetStyle(); + if ( styl = asScoped ) then begin + itmName := GetItemName(); + end else begin + itmName := AName; + end; + len := AStore.BeginArrayRead(AName,ATypeInfo,styl,itmName); + if ( len >= 0 ) then begin + Try + If Not Assigned(AObject) Then + AObject := Create(); + itmTypInfo := PTypeInfo(GetItemClass().ClassInfo); + nativObj := AObject as TObjectCollectionRemotable; + If ( len > 0 ) Then Begin + s := ''; + nativObj.Clear(); + For i := 0 To Pred(len) Do Begin + itm := nativObj.Add(); + AStore.Get(itmTypInfo,s,itm); + End; + End; + Finally + AStore.EndScopeRead(); + End; + end; +end; + +class function TObjectCollectionRemotable.GetItemTypeInfo() : PTypeInfo; +begin + Result := PTypeInfo(GetItemClass().ClassInfo); +end; + +constructor TObjectCollectionRemotable.Create(); +begin + inherited Create(); + FList := TObjectList.Create(True); +end; + +destructor TObjectCollectionRemotable.Destroy(); +begin + FList.Free(); + inherited Destroy(); +end; + +procedure TObjectCollectionRemotable.Assign(Source : TPersistent); +var + srcCol : TObjectCollectionRemotable; + src : TBaseObjectArrayRemotable; + i, c : PtrInt; +begin + if Assigned(Source) then begin + if Source.InheritsFrom(TObjectCollectionRemotable) then begin + srcCol := TObjectCollectionRemotable(Source); + c := srcCol.Length; + FList.Clear(); + FList.Capacity := c; + for i := 0 to Pred(c) do begin + Add().Assign(srcCol.Item[i]); + end; + end else if Source.InheritsFrom(TBaseObjectArrayRemotable) then begin + src := TBaseObjectArrayRemotable(Source); + c := src.Length; + FList.Clear(); + FList.Capacity := c; + for i := 0 to Pred(c) do begin + Add().Assign(src.Item[i]); + end; + end else begin + inherited Assign(Source); + end; + end else begin + FList.Clear(); + end; +end; + +function TObjectCollectionRemotable.Equal(const ACompareTo : TBaseRemotable) : Boolean; +var + i : PtrInt; + nativeCol : TObjectCollectionRemotable; + nativeArray : TBaseObjectArrayRemotable; + res : Boolean; +begin + res := False; + if ( ACompareTo <> nil ) then begin + if ACompareTo.InheritsFrom(TObjectCollectionRemotable) then begin + nativeCol := TObjectCollectionRemotable(ACompareTo); + if ( nativeCol.Length = Length ) then begin + res := True; + for i := 0 to Pred(Length) do begin + if not Item[i].Equal(nativeCol[i]) then begin + res := False; + Break; + end; + end; + end; + end else if ACompareTo.InheritsFrom(TBaseObjectArrayRemotable) then begin + nativeArray := TBaseObjectArrayRemotable(ACompareTo); + if ( nativeArray.Length = Length ) then begin + res := True; + for i := 0 to Pred(Length) do begin + if not Item[i].Equal(nativeArray[i]) then begin + res := False; + Break; + end; + end; + end; + end; + end; + Result := res; +end; + +function TObjectCollectionRemotable.Add() : TBaseRemotable; +begin + Result := GetItemClass().Create(); + try + FList.Add(Result); + except + Result.Free(); + raise; + end; +end; + +function TObjectCollectionRemotable.AddAt(const APosition : PtrInt) : TBaseRemotable; +begin + FList.Insert(APosition,nil); + try + Result := GetItemClass().Create(); + except + FList.Delete(APosition); + raise; + end; + FList[APosition] := Result; +end; + +function TObjectCollectionRemotable.Extract(const AIndex : PtrInt) : TBaseRemotable; +begin + Result := TBaseRemotable(FList.Extract(FList[AIndex])); +end; + +procedure TObjectCollectionRemotable.Delete(const AIndex : PtrInt); +begin + FList.Delete(AIndex); +end; + +procedure TObjectCollectionRemotable.Exchange(const Index1, Index2 : PtrInt); +begin + FList.Exchange(Index1,Index2); +end; + +procedure TObjectCollectionRemotable.Clear(); +begin + FList.Clear(); +end; + +function TObjectCollectionRemotable.IndexOf(AObject : TBaseRemotable) : PtrInt; +begin + Result := FList.IndexOf(AObject); +end; + { TBaseArrayRemotable } class function TBaseArrayRemotable.GetItemName(): string; diff --git a/wst/trunk/ide/lazarus/wstimportdlg.lfm b/wst/trunk/ide/lazarus/wstimportdlg.lfm index 5b0a8b021..8fe63a88e 100644 --- a/wst/trunk/ide/lazarus/wstimportdlg.lfm +++ b/wst/trunk/ide/lazarus/wstimportdlg.lfm @@ -1,7 +1,7 @@ object formImport: TformImport Left = 574 Height = 553 - Top = 132 + Top = 133 Width = 526 HorzScrollBar.Page = 525 VertScrollBar.Page = 552 @@ -10,6 +10,7 @@ object formImport: TformImport Caption = 'WSDL Importer' ClientHeight = 553 ClientWidth = 526 + LCLVersion = '0.9.25' object Panel2: TPanel Height = 505 Width = 526 @@ -226,7 +227,6 @@ object formImport: TformImport end end object OD: TOpenDialog - Title = 'Ouvrir un fichier existant' Filter = 'WSDL Files ( *.wsdl )|*.wsdl' FilterIndex = 0 Options = [ofFileMustExist, ofEnableSizing, ofViewDetail] @@ -234,7 +234,6 @@ object formImport: TformImport top = 32 end object SDD: TSelectDirectoryDialog - Title = 'Choisir un répertoire' FilterIndex = 0 left = 224 top = 176 diff --git a/wst/trunk/ide/lazarus/wstimportdlg.lrs b/wst/trunk/ide/lazarus/wstimportdlg.lrs index d799f036a..9dfce83e7 100644 --- a/wst/trunk/ide/lazarus/wstimportdlg.lrs +++ b/wst/trunk/ide/lazarus/wstimportdlg.lrs @@ -2,67 +2,66 @@ LazarusResources.Add('TformImport','FORMDATA',[ 'TPF0'#11'TformImport'#10'formImport'#4'Left'#3'>'#2#6'Height'#3')'#2#3'Top'#3 - +#132#0#5'Width'#3#14#2#18'HorzScrollBar.Page'#3#13#2#18'VertScrollBar.Page'#3 + +#133#0#5'Width'#3#14#2#18'HorzScrollBar.Page'#3#13#2#18'VertScrollBar.Page'#3 +'('#2#13'ActiveControl'#7#7'Button1'#11'BorderStyle'#7#13'bsSizeToolWin'#7'C' - +'aption'#6#13'WSDL Importer'#12'ClientHeight'#3')'#2#11'ClientWidth'#3#14#2#0 - +#6'TPanel'#6'Panel2'#6'Height'#3#249#1#5'Width'#3#14#2#5'Align'#7#8'alClient' - +#12'ClientHeight'#3#249#1#11'ClientWidth'#3#14#2#8'TabOrder'#2#1#0#9'TGroupB' - +'ox'#9'GroupBox1'#4'Left'#2#8#6'Height'#3#168#0#3'Top'#2#8#5'Width'#3#250#1#7 - +'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#12'ClientHeight'#3#150#0#11'Cli' - +'entWidth'#3#246#1#8'TabOrder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2#9#6'Heigh' - +'t'#2#14#3'Top'#2#4#5'Width'#3#186#0#7'Caption'#6'&Web Services Description ' - +'File ( WSDL )'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#9#6'Heig' - +'ht'#2#14#3'Top'#2'E'#5'Width'#2'Q'#7'Caption'#6#16'Output directory'#11'Par' - +'entColor'#8#0#0#5'TEdit'#12'edtInputFile'#4'Left'#2#9#6'Height'#2#23#3'Top' - +#2#31#5'Width'#3'|'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrd' - +'er'#2#0#0#0#7'TButton'#7'Button2'#4'Left'#3#151#1#6'Height'#2#25#3'Top'#2#31 - +#5'Width'#2'('#6'Action'#7#11'actOpenFile'#7'Anchors'#11#5'akTop'#7'akRight' - +#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#1#0#0#5'TEdit'#12'edtOutp' - +'utDir'#4'Left'#2#9#6'Height'#2#23#3'Top'#2'X'#5'Width'#3'|'#1#7'Anchors'#11 - +#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#2#0#0#7'TButton'#7'Button3'#4 - +'Left'#3#151#1#6'Height'#2#25#3'Top'#2'X'#5'Width'#2'('#6'Action'#7#10'actOp' - +'enDir'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4 - +#8'TabOrder'#2#3#0#0#9'TCheckBox'#15'edtAddToProject'#4'Left'#2#9#6'Height'#2 - +#19#3'Top'#3#128#0#5'Width'#3#182#0#7'Caption'#6'"Add the generated files to' - +' project'#8'TabOrder'#2#4#0#0#0#9'TGroupBox'#9'GroupBox2'#4'Left'#2#8#6'Hei' - +'ght'#3#161#0#3'Top'#3'P'#1#5'Width'#3#250#1#7'Anchors'#11#5'akTop'#6'akLeft' - +#7'akRight'#8'akBottom'#0#7'Caption'#6#12' Messages '#12'ClientHeight'#3 - +#143#0#11'ClientWidth'#3#246#1#8'TabOrder'#2#2#0#5'TMemo'#6'mmoLog'#6'Height' - +#3#143#0#5'Width'#3#246#1#5'Align'#7#8'alClient'#8'ReadOnly'#9#10'ScrollBars' - +#7#6'ssBoth'#8'TabOrder'#2#0#0#0#0#9'TGroupBox'#9'GroupBox3'#4'Left'#2#8#6'H' - +'eight'#3#136#0#3'Top'#3#184#0#5'Width'#3#250#1#7'Anchors'#11#5'akTop'#6'akL' - +'eft'#7'akRight'#0#7'Caption'#6#11' Options '#12'ClientHeight'#2'v'#11'Cli' - +'entWidth'#3#246#1#8'TabOrder'#2#1#0#9'TCheckBox'#13'edtOptionIntf'#4'Left'#2 - +#9#6'Height'#2#19#3'Top'#2#8#5'Width'#2'T'#7'Caption'#6#14'Interface file'#7 - +'Checked'#9#7'OnClick'#7#18'edtOptionIntfClick'#5'State'#7#9'cbChecked'#8'Ta' - +'bOrder'#2#0#0#0#9'TCheckBox'#14'edtOptionProxy'#4'Left'#2#9#6'Height'#2#19#3 - +'Top'#2'8'#5'Width'#2'D'#7'Caption'#6#10'Proxy file'#7'Checked'#9#5'State'#7 - +#9'cbChecked'#8'TabOrder'#2#2#0#0#9'TCheckBox'#15'edtOptionBinder'#4'Left'#3 - +'&'#1#6'Height'#2#19#3'Top'#2#8#5'Width'#2'o'#7'Caption'#6#19'Service Binder' - +' file'#8'TabOrder'#2#3#0#0#9'TCheckBox'#12'edtOptionImp'#4'Left'#3'&'#1#6'H' - +'eight'#2#19#3'Top'#2'8'#5'Width'#3#158#0#7'Caption'#6#28'Implementation Ske' - +'leton file'#8'TabOrder'#2#4#0#0#9'TCheckBox'#16'edtOptionIntfALL'#4'Left'#2 - +#30#6'Height'#2#19#3'Top'#2' '#5'Width'#2'^'#7'Caption'#6#15'Parse all types' - +#7'OnClick'#7#21'edtOptionIntfALLClick'#8'TabOrder'#2#1#0#0#9'TCheckBox'#22 - +'edtOptionWrappedParams'#4'Left'#2#9#6'Height'#2#19#3'Top'#2'`'#5'Width'#3'"' - +#1#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6'5Generate easy access ' - +'interface for wrapped parameters'#8'TabOrder'#2#5#0#0#0#0#6'TPanel'#6'Panel' - +'1'#6'Height'#2'0'#3'Top'#3#249#1#5'Width'#3#14#2#5'Align'#7#8'alBottom'#12 - +'ClientHeight'#2'0'#11'ClientWidth'#3#14#2#8'TabOrder'#2#0#0#7'TButton'#7'Bu' - +'tton1'#4'Left'#3'_'#1#6'Height'#2#25#3'Top'#2#8#5'Width'#2'K'#6'Action'#7#5 - +'actOK'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4 - +#7'Default'#9#8'TabOrder'#2#0#0#0#7'TButton'#7'Button4'#4'Left'#3#183#1#6'He' - +'ight'#2#25#3'Top'#2#8#5'Width'#2'K'#7'Anchors'#11#5'akTop'#7'akRight'#0#25 - +'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalR' - +'esult'#2#2#8'TabOrder'#2#1#0#0#0#11'TActionList'#2'AL'#4'left'#2'h'#3'top'#3 - +'H'#1#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18'DisableIfNoHandler'#9#9'On' - +'Execute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actOKUpdate'#0#0#7'TAction'#11 - +'actOpenFile'#7'Caption'#6#3'...'#18'DisableIfNoHandler'#9#9'OnExecute'#7#18 - +'actOpenFileExecute'#0#0#7'TAction'#10'actOpenDir'#7'Caption'#6#3'...'#18'Di' - +'sableIfNoHandler'#9#9'OnExecute'#7#17'actOpenDirExecute'#0#0#0#11'TOpenDial' - +'og'#2'OD'#5'Title'#6#26'Ouvrir un fichier existant'#6'Filter'#6#28'WSDL Fil' - +'es ( *.wsdl )|*.wsdl'#11'FilterIndex'#2#0#7'Options'#11#15'ofFileMustExist' - +#14'ofEnableSizing'#12'ofViewDetail'#0#4'left'#3#16#1#3'top'#2' '#0#0#22'TSe' - +'lectDirectoryDialog'#3'SDD'#5'Title'#6#21'Choisir un r'#233'pertoire'#11'Fi' - +'lterIndex'#2#0#4'left'#3#224#0#3'top'#3#176#0#0#0#0 + +'aption'#6#13'WSDL Importer'#12'ClientHeight'#3')'#2#11'ClientWidth'#3#14#2 + +#10'LCLVersion'#6#6'0.9.25'#0#6'TPanel'#6'Panel2'#6'Height'#3#249#1#5'Width' + +#3#14#2#5'Align'#7#8'alClient'#12'ClientHeight'#3#249#1#11'ClientWidth'#3#14 + +#2#8'TabOrder'#2#1#0#9'TGroupBox'#9'GroupBox1'#4'Left'#2#8#6'Height'#3#168#0 + +#3'Top'#2#8#5'Width'#3#250#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#12 + +'ClientHeight'#3#150#0#11'ClientWidth'#3#246#1#8'TabOrder'#2#0#0#6'TLabel'#6 + +'Label1'#4'Left'#2#9#6'Height'#2#14#3'Top'#2#4#5'Width'#3#186#0#7'Caption'#6 + +'&Web Services Description File ( WSDL )'#11'ParentColor'#8#0#0#6'TLabel'#6 + +'Label2'#4'Left'#2#9#6'Height'#2#14#3'Top'#2'E'#5'Width'#2'Q'#7'Caption'#6#16 + +'Output directory'#11'ParentColor'#8#0#0#5'TEdit'#12'edtInputFile'#4'Left'#2 + +#9#6'Height'#2#23#3'Top'#2#31#5'Width'#3'|'#1#7'Anchors'#11#5'akTop'#6'akLef' + +'t'#7'akRight'#0#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Left'#3#151#1#6 + +'Height'#2#25#3'Top'#2#31#5'Width'#2'('#6'Action'#7#11'actOpenFile'#7'Anchor' + +'s'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2 + +#1#0#0#5'TEdit'#12'edtOutputDir'#4'Left'#2#9#6'Height'#2#23#3'Top'#2'X'#5'Wi' + +'dth'#3'|'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#2#0 + +#0#7'TButton'#7'Button3'#4'Left'#3#151#1#6'Height'#2#25#3'Top'#2'X'#5'Width' + +#2'('#6'Action'#7#10'actOpenDir'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'Bord' + +'erSpacing.InnerBorder'#2#4#8'TabOrder'#2#3#0#0#9'TCheckBox'#15'edtAddToProj' + +'ect'#4'Left'#2#9#6'Height'#2#19#3'Top'#3#128#0#5'Width'#3#182#0#7'Caption'#6 + +'"Add the generated files to project'#8'TabOrder'#2#4#0#0#0#9'TGroupBox'#9'G' + +'roupBox2'#4'Left'#2#8#6'Height'#3#161#0#3'Top'#3'P'#1#5'Width'#3#250#1#7'An' + +'chors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#7'Caption'#6#12' Mes' + +'sages '#12'ClientHeight'#3#143#0#11'ClientWidth'#3#246#1#8'TabOrder'#2#2#0 + +#5'TMemo'#6'mmoLog'#6'Height'#3#143#0#5'Width'#3#246#1#5'Align'#7#8'alClient' + +#8'ReadOnly'#9#10'ScrollBars'#7#6'ssBoth'#8'TabOrder'#2#0#0#0#0#9'TGroupBox' + +#9'GroupBox3'#4'Left'#2#8#6'Height'#3#136#0#3'Top'#3#184#0#5'Width'#3#250#1#7 + +'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#7'Caption'#6#11' Options '#12 + +'ClientHeight'#2'v'#11'ClientWidth'#3#246#1#8'TabOrder'#2#1#0#9'TCheckBox'#13 + +'edtOptionIntf'#4'Left'#2#9#6'Height'#2#19#3'Top'#2#8#5'Width'#2'T'#7'Captio' + +'n'#6#14'Interface file'#7'Checked'#9#7'OnClick'#7#18'edtOptionIntfClick'#5 + +'State'#7#9'cbChecked'#8'TabOrder'#2#0#0#0#9'TCheckBox'#14'edtOptionProxy'#4 + +'Left'#2#9#6'Height'#2#19#3'Top'#2'8'#5'Width'#2'D'#7'Caption'#6#10'Proxy fi' + +'le'#7'Checked'#9#5'State'#7#9'cbChecked'#8'TabOrder'#2#2#0#0#9'TCheckBox'#15 + +'edtOptionBinder'#4'Left'#3'&'#1#6'Height'#2#19#3'Top'#2#8#5'Width'#2'o'#7'C' + +'aption'#6#19'Service Binder file'#8'TabOrder'#2#3#0#0#9'TCheckBox'#12'edtOp' + +'tionImp'#4'Left'#3'&'#1#6'Height'#2#19#3'Top'#2'8'#5'Width'#3#158#0#7'Capti' + +'on'#6#28'Implementation Skeleton file'#8'TabOrder'#2#4#0#0#9'TCheckBox'#16 + +'edtOptionIntfALL'#4'Left'#2#30#6'Height'#2#19#3'Top'#2' '#5'Width'#2'^'#7'C' + +'aption'#6#15'Parse all types'#7'OnClick'#7#21'edtOptionIntfALLClick'#8'TabO' + +'rder'#2#1#0#0#9'TCheckBox'#22'edtOptionWrappedParams'#4'Left'#2#9#6'Height' + +#2#19#3'Top'#2'`'#5'Width'#3'"'#1#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Ca' + +'ption'#6'5Generate easy access interface for wrapped parameters'#8'TabOrder' + +#2#5#0#0#0#0#6'TPanel'#6'Panel1'#6'Height'#2'0'#3'Top'#3#249#1#5'Width'#3#14 + +#2#5'Align'#7#8'alBottom'#12'ClientHeight'#2'0'#11'ClientWidth'#3#14#2#8'Tab' + +'Order'#2#0#0#7'TButton'#7'Button1'#4'Left'#3'_'#1#6'Height'#2#25#3'Top'#2#8 + +#5'Width'#2'K'#6'Action'#7#5'actOK'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'B' + +'orderSpacing.InnerBorder'#2#4#7'Default'#9#8'TabOrder'#2#0#0#0#7'TButton'#7 + +'Button4'#4'Left'#3#183#1#6'Height'#2#25#3'Top'#2#8#5'Width'#2'K'#7'Anchors' + +#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Ca' + +'ption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#1#0#0#0#11'TActionList' + +#2'AL'#4'left'#2'h'#3'top'#3'H'#1#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18 + +'DisableIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actO' + +'KUpdate'#0#0#7'TAction'#11'actOpenFile'#7'Caption'#6#3'...'#18'DisableIfNoH' + +'andler'#9#9'OnExecute'#7#18'actOpenFileExecute'#0#0#7'TAction'#10'actOpenDi' + +'r'#7'Caption'#6#3'...'#18'DisableIfNoHandler'#9#9'OnExecute'#7#17'actOpenDi' + +'rExecute'#0#0#0#11'TOpenDialog'#2'OD'#6'Filter'#6#28'WSDL Files ( *.wsdl )|' + +'*.wsdl'#11'FilterIndex'#2#0#7'Options'#11#15'ofFileMustExist'#14'ofEnableSi' + +'zing'#12'ofViewDetail'#0#4'left'#3#16#1#3'top'#2' '#0#0#22'TSelectDirectory' + +'Dialog'#3'SDD'#11'FilterIndex'#2#0#4'left'#3#224#0#3'top'#3#176#0#0#0#0 ]); diff --git a/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dof b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dof index d1decad22..1f4cae9e5 100644 --- a/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dof +++ b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dof @@ -141,20 +141,21 @@ Item0=DUnit Count=1 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; [HistoryLists\hlSearchPath] -Count=13 +Count=14 Item0=..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item1=..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;..\..\..\ws_helper -Item2=..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;..\..\..\fcl-units\fcl-passrc\src -Item3=..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item4=..\;..\..\;..\..\..\;C:\Programmes\lazarus\wst\trunk\ws_helper;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item5=..\;..\..\;..\..\..\;..\..\ws_helper;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item6=..\;..\..\;..\..\..\;..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item7=..\;..\..\;..\..\..\;..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;C:\Programmes\lazarus\wst\trunk\ws_helper -Item8=..\;..\..\;..\..\..\;..\..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item9=..\;..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item10=..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item11=C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src -Item12=..\ +Item1=$(DELPHI)\Lib\Debug;C:\PROGRA~1\Borland\Delphi7\MyTools\JVCL\3.20\jcl\lib\d7\debug;..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item2=..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;..\..\..\ws_helper +Item3=..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;..\..\..\fcl-units\fcl-passrc\src +Item4=..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item5=..\;..\..\;..\..\..\;C:\Programmes\lazarus\wst\trunk\ws_helper;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item6=..\;..\..\;..\..\..\;..\..\ws_helper;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item7=..\;..\..\;..\..\..\;..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item8=..\;..\..\;..\..\..\;..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;C:\Programmes\lazarus\wst\trunk\ws_helper +Item9=..\;..\..\;..\..\..\;..\..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item10=..\;..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item11=..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item12=C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item13=..\ [HistoryLists\hlUnitOutputDirectory] Count=1 Item0=obj diff --git a/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr index fb6257a34..5d10a49ce 100644 --- a/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr +++ b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr @@ -20,7 +20,10 @@ uses xsd_consts in '..\..\..\ws_helper\xsd_consts.pas', xsd_generator in '..\..\..\ws_helper\xsd_generator.pas', test_generators in '..\test_generators.pas', - test_suite_utils in '..\test_suite_utils.pas'; + test_suite_utils in '..\test_suite_utils.pas', + test_std_cursors in '..\test_std_cursors.pas', + test_rtti_filter in '..\test_rtti_filter.pas', + test_wst_cursors in '..\test_wst_cursors.pas'; {$R *.res} diff --git a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr index e1175ae6c..41b83d9f5 100644 --- a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr +++ b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr @@ -9,7 +9,10 @@ uses testformatter_unit in '..\testformatter_unit.pas', test_parsers in '..\test_parsers.pas', testmetadata_unit, - test_support in '..\test_support.pas'; + test_support in '..\test_support.pas', + test_std_cursors in '..\test_std_cursors.pas', + test_rtti_filter in '..\test_rtti_filter.pas', + test_wst_cursors in '..\test_wst_cursors.pas'; {$R *.res} diff --git a/wst/trunk/tests/test_suite/files/class_extent_native_type.xsd b/wst/trunk/tests/test_suite/files/class_extent_native_type.xsd new file mode 100644 index 000000000..35521a5c2 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/class_extent_native_type.xsd @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_array_sequence_collection.WSDL b/wst/trunk/tests/test_suite/files/complex_array_sequence_collection.WSDL new file mode 100644 index 000000000..048863e81 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_array_sequence_collection.WSDL @@ -0,0 +1,47 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_array_sequence_collection.xsd b/wst/trunk/tests/test_suite/files/complex_array_sequence_collection.xsd new file mode 100644 index 000000000..2f6c2bebb --- /dev/null +++ b/wst/trunk/tests/test_suite/files/complex_array_sequence_collection.xsd @@ -0,0 +1,35 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/complex_record.WSDL b/wst/trunk/tests/test_suite/files/complex_record.WSDL index 9e9ff722d..5a97ef270 100644 --- a/wst/trunk/tests/test_suite/files/complex_record.WSDL +++ b/wst/trunk/tests/test_suite/files/complex_record.WSDL @@ -7,9 +7,9 @@ targetNamespace="urn:wst-test"> - + - + @@ -24,7 +24,7 @@ - + diff --git a/wst/trunk/tests/test_suite/files/complex_record.xsd b/wst/trunk/tests/test_suite/files/complex_record.xsd index 597618f61..ccd846611 100644 --- a/wst/trunk/tests/test_suite/files/complex_record.xsd +++ b/wst/trunk/tests/test_suite/files/complex_record.xsd @@ -1,9 +1,10 @@ - + @@ -18,7 +19,7 @@ - + diff --git a/wst/trunk/tests/test_suite/files/complex_record_embedded.WSDL b/wst/trunk/tests/test_suite/files/complex_record_embedded.WSDL index 45821de1e..8fd65c11f 100644 --- a/wst/trunk/tests/test_suite/files/complex_record_embedded.WSDL +++ b/wst/trunk/tests/test_suite/files/complex_record_embedded.WSDL @@ -4,13 +4,14 @@ xmlns:tns="library1" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" + xmlns:wst="urn:wst_base" targetNamespace="urn:wst-test"> - + @@ -25,7 +26,7 @@ - + diff --git a/wst/trunk/tests/test_suite/files/complex_record_embedded.xsd b/wst/trunk/tests/test_suite/files/complex_record_embedded.xsd index 7c97119f8..088678052 100644 --- a/wst/trunk/tests/test_suite/files/complex_record_embedded.xsd +++ b/wst/trunk/tests/test_suite/files/complex_record_embedded.xsd @@ -1,10 +1,11 @@ - + @@ -19,7 +20,7 @@ - + diff --git a/wst/trunk/tests/test_suite/files/pascal_class_parent.WSDL b/wst/trunk/tests/test_suite/files/pascal_class_parent.WSDL new file mode 100644 index 000000000..a5f4a62cd --- /dev/null +++ b/wst/trunk/tests/test_suite/files/pascal_class_parent.WSDL @@ -0,0 +1,20 @@ + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/pascal_class_parent.xsd b/wst/trunk/tests/test_suite/files/pascal_class_parent.xsd new file mode 100644 index 000000000..7909cfb28 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/pascal_class_parent.xsd @@ -0,0 +1,8 @@ + + + + + + diff --git a/wst/trunk/tests/test_suite/test_generators.pas b/wst/trunk/tests/test_suite/test_generators.pas index f54f488c3..039ffdb81 100644 --- a/wst/trunk/tests/test_suite/test_generators.pas +++ b/wst/trunk/tests/test_suite/test_generators.pas @@ -26,6 +26,8 @@ type TPropertyType = ( ptField, ptAttribute ); + { TTest_CustomXsdGenerator } + TTest_CustomXsdGenerator = class(TTestCase) protected function CreateGenerator(const ADoc : TXMLDocument) : IXsdGenerator;virtual;abstract; @@ -33,6 +35,7 @@ type published procedure class_properties_default(); procedure class_properties_extended_metadata(); + procedure class_extent_native_type(); end; TTest_XsdGenerator = class(TTest_CustomXsdGenerator) @@ -181,6 +184,76 @@ begin end; end; +procedure TTest_CustomXsdGenerator.class_extent_native_type(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + cltyp : TPasClassType; + + procedure AddProperty( + const AName, + ATypeName, + ADefault : string; + const AKind : TPropertyType + ); + var + p : TPasProperty; + begin + p := TPasProperty(tr.CreateElement(TPasProperty,AName,cltyp,visDefault,'',0)); + cltyp.Members.Add(p); + p.ReadAccessorName := 'F' + AName; + p.WriteAccessorName := 'F' + AName; + p.VarType := tr.FindElement(ATypeName) as TPasType; + Check( (p.VarType <> nil), Format('Type not found : "%s".',[ATypeName])); + p.VarType.AddRef(); + p.DefaultValue := ADefault; + p.Visibility := visPublished; + p.StoredAccessorName := 'True'; + if ( AKind = ptAttribute ) then + tr.SetPropertyAsAttribute(p,True); + end; + +var + g : IGenerator; + locDoc, locExistDoc : TXMLDocument; +begin + locDoc := nil; + locExistDoc := nil; + tr := TwstPasTreeContainer.Create(); + try + CreateWstInterfaceSymbolTable(tr); + mdl := TPasModule(tr.CreateElement(TPasModule,'class_extent_native_type',tr.Package,visDefault,'',0)); + tr.Package.Modules.Add(mdl); + mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0)); + cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TExtendString',mdl.InterfaceSection,visDefault,'',0)); + cltyp.ObjKind := okClass; + cltyp.AncestorType := tr.FindElementNS('TComplexStringContentRemotable',sXSD_NS) as TPasType; + cltyp.AncestorType.AddRef(); + mdl.InterfaceSection.Declarations.Add(cltyp); + mdl.InterfaceSection.Types.Add(cltyp); + AddProperty('intAtt','integer','',ptAttribute); + + cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TExtendBase64String',mdl.InterfaceSection,visDefault,'',0)); + cltyp.ObjKind := okClass; + cltyp.AncestorType := tr.FindElementNS('TBase64StringExtRemotable',sXSD_NS) as TPasType; + cltyp.AncestorType.AddRef(); + mdl.InterfaceSection.Declarations.Add(cltyp); + mdl.InterfaceSection.Types.Add(cltyp); + AddProperty('strAtt','string','',ptAttribute); + + locDoc := CreateDoc(); + g := CreateGenerator(locDoc); + g.Execute(tr,mdl.Name); + WriteXMLFile(locDoc,'.\class_extent_native_type.xsd'); + locExistDoc := LoadXmlFromFilesList('class_extent_native_type.xsd'); + Check(CompareNodes(locExistDoc,locDoc),'generated document differs from the existent one.'); + finally + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + FreeAndNil(tr); + end; +end; + function TTest_CustomXsdGenerator.LoadXmlFromFilesList(const AFileName: string): TXMLDocument; var locFileName : string; diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index f83924362..15cf56c8b 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -45,6 +45,10 @@ type function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;virtual;abstract; function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;virtual;abstract; + + function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;virtual;abstract; + + function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;virtual;abstract; published procedure EmptySchema(); @@ -63,6 +67,9 @@ type procedure ComplexType_ArraySequence(); procedure ComplexType_ArraySequence_Embedded(); + + procedure ComplexType_CollectionSequence(); + procedure pascal_class_default_parent(); end; { TTest_XsdParser } @@ -88,6 +95,10 @@ type function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;override; + + function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override; + + function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;override; end; { TTest_WsdlParser } @@ -113,6 +124,10 @@ type function LoadComplexType_ArraySequence_Schema() : TwstPasTreeContainer;override; function LoadComplexType_ArraySequence_Embedded_Schema() : TwstPasTreeContainer;override; + + function LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer;override; + + function LoadComplexType_pascal_class_parent() : TwstPasTreeContainer;override; published procedure no_binding_style(); end; @@ -123,6 +138,11 @@ uses parserutils; const x_complexType_SampleArrayIntFieldType = 'TArrayIntFieldType'; x_complexType_SampleArrayItemType = 'TArrayItemType'; + + x_complexType_SampleCollectionComplexType = 'TComplexType'; + x_complexType_SampleCollectionCollectionComplexType = 'TCollectionComplexType'; + x_complexType_SampleCollectionItemType = 'TCollectionItemType'; + x_complexType_SampleDerivedType = 'TClassSampleDerivedType'; x_complexType_SampleClassType = 'TClassSampleType'; x_complexType_SampleClassTypeA = 'TClassSampleTypeA'; @@ -135,6 +155,8 @@ const x_complexType_array_sequence = 'complex_array_sequence'; x_complexType_array_sequence_embedded = 'complex_array_sequence_embedded'; + x_complexType_array_sequence_collection = 'complex_array_sequence_collection'; + x_complexType_class = 'complex_class'; x_complexType_class_default = 'complex_class_default'; x_complexType_class_properties_extended_metadata = 'class_properties_extended_metadata'; @@ -162,6 +184,7 @@ const x_charField = 'charField'; x_classField = 'classField'; x_enumField = 'enumField'; + x_field = 'field'; x_floatField = 'floatField'; x_intField = 'intField'; x_longField = 'longField'; @@ -586,6 +609,7 @@ var i : Integer; prpLs : TList; begin + tr := nil; prpLs := TList.Create(); try tr := LoadComplexType_Class_Extend_Simple_Schema(); @@ -602,6 +626,9 @@ begin CheckEquals(x_complexType_SampleClassType,tr.GetExternalName(elt)); CheckIs(elt,TPasClassType); clsType := elt as TPasClassType; + CheckNotNull(clsType.AncestorType,'AncestorType is null'); + CheckSame(tr.FindElementNS('TComplexStringContentRemotable',sXSD_NS),clsType.AncestorType); + prpLs.Clear(); for i := 0 to Pred(clsType.Members.Count) do begin if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then @@ -617,6 +644,9 @@ begin CheckEquals(x_complexType_SampleClassTypeA,tr.GetExternalName(elt)); CheckIs(elt,TPasClassType); clsType := elt as TPasClassType; + CheckNotNull(clsType.AncestorType,'AncestorType is null'); + CheckSame(tr.FindElementNS('TBase64StringExtRemotable',sXSD_NS),clsType.AncestorType); + prpLs.Clear(); for i := 0 to Pred(clsType.Members.Count) do begin if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then @@ -625,6 +655,7 @@ begin CheckEquals(1,prpLs.Count); CheckProperty(x_floatField,'float',ptAttribute); finally + tr.Free(); FreeAndNil(prpLs); end; end; @@ -982,7 +1013,121 @@ begin end; end; -procedure TTest_CustomXsdParser.ComplexType_Class_default_values; +procedure TTest_CustomXsdParser.ComplexType_CollectionSequence(); +var + tr : TwstPasTreeContainer; + clsType : TPasClassType; + + procedure CheckProperty(const AName,ATypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,tr.GetExternalName(prp.VarType)); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + ls : TList; + elt : TPasElement; + arrayType : TPasArrayType; + aliasType : TPasAliasType; + i : Integer; + prpLs : TList; + nestedClassName : string; +begin + prpLs := TList.Create(); + try + tr := LoadComplexType_CollectionSequence_Schema(); + + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + CheckEquals(x_complexType_array_sequence_collection,mdl.Name); + CheckEquals(x_targetNamespace,tr.GetExternalName(mdl)); + ls := mdl.InterfaceSection.Declarations; + CheckEquals(4,ls.Count); + elt := tr.FindElement(x_complexType_SampleCollectionCollectionComplexType); + CheckNotNull(elt,x_complexType_SampleCollectionCollectionComplexType); + CheckEquals(x_complexType_SampleCollectionCollectionComplexType,elt.Name); + CheckEquals(x_complexType_SampleCollectionCollectionComplexType,tr.GetExternalName(elt)); + CheckIs(elt,TPasArrayType); + arrayType := elt as TPasArrayType; + Check(tr.IsCollection(arrayType)); + CheckNotNull(arrayType.ElType); + CheckEquals(x_complexType_SampleCollectionComplexType,tr.GetExternalName(arrayType.ElType)); + CheckEquals(x_field,tr.GetArrayItemName(arrayType)); + CheckEquals(x_field,tr.GetArrayItemExternalName(arrayType)); + + + nestedClassName := Format('%s_%s_Type',[x_complexType_SampleCollectionItemType,x_Item]); + elt := tr.FindElement(nestedClassName); + CheckNotNull(elt,nestedClassName); + CheckEquals(nestedClassName,elt.Name,'Item Name'); + CheckEquals(nestedClassName,tr.GetExternalName(elt),'Item ExternalName'); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + + prpLs.Clear(); + for i := 0 to Pred(clsType.Members.Count) do begin + if TPasElement(clsType.Members[i]).InheritsFrom(TPasProperty) then + prpLs.Add(clsType.Members[i]); + end; + CheckEquals(8,prpLs.Count); + CheckProperty(x_intField,'int',ptField); + CheckProperty(x_strField,'string',ptField); + CheckProperty(x_floatField,'float',ptField); + CheckProperty(x_byteField,'byte',ptField); + CheckProperty(x_charField,'char',ptField); + CheckProperty(x_longField,'long',ptField); + CheckProperty(x_strAtt,'string',ptAttribute); + CheckProperty(x_intAtt,'int',ptAttribute); + + elt := tr.FindElement(x_complexType_SampleCollectionItemType); + CheckNotNull(elt,x_complexType_SampleCollectionItemType); + CheckEquals(x_complexType_SampleCollectionItemType,elt.Name, 'Array name'); + CheckEquals(x_complexType_SampleCollectionItemType,tr.GetExternalName(elt), 'Array external name'); + CheckIs(elt,TPasArrayType); + arrayType := elt as TPasArrayType; + Check(tr.IsCollection(arrayType)); + CheckNotNull(arrayType.ElType); + CheckEquals(nestedClassName,tr.GetExternalName(arrayType.ElType)); + CheckEquals(x_Item,tr.GetArrayItemExternalName(arrayType)); + + finally + FreeAndNil(prpLs); + end; +end; + +procedure TTest_CustomXsdParser.pascal_class_default_parent(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + clsType : TPasClassType; + elt : TPasElement; +begin + tr := LoadComplexType_pascal_class_parent(); + try + mdl := tr.FindModule(x_targetNamespace); + CheckNotNull(mdl); + elt := tr.FindElement(x_complexType_SampleClass); + CheckNotNull(elt,x_complexType_SampleClass); + CheckEquals(x_complexType_SampleClass,elt.Name); + CheckEquals(x_complexType_SampleClass,tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + CheckNotNull(clsType.AncestorType,'AncestorType is null'); + CheckSame(tr.FindElementNS('TBaseComplexRemotable',sXSD_NS),clsType.AncestorType); + finally + tr.Free(); + end; +end; + +procedure TTest_CustomXsdParser.ComplexType_Class_default_values(); var tr : TwstPasTreeContainer; clsType : TPasClassType; @@ -1198,6 +1343,16 @@ begin Result := ParseDoc(x_complexType_array_sequence_embedded); end; +function TTest_XsdParser.LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_array_sequence_collection); +end; + +function TTest_XsdParser.LoadComplexType_pascal_class_parent() : TwstPasTreeContainer; +begin + Result := ParseDoc('pascal_class_parent'); +end; + function TTest_XsdParser.LoadComplexType_Class_default_values() : TwstPasTreeContainer; begin Result := ParseDoc(x_complexType_class_default); @@ -1286,6 +1441,16 @@ begin Result := ParseDoc(x_complexType_array_sequence_embedded); end; +function TTest_WsdlParser.LoadComplexType_CollectionSequence_Schema() : TwstPasTreeContainer; +begin + Result := ParseDoc(x_complexType_array_sequence_collection); +end; + +function TTest_WsdlParser.LoadComplexType_pascal_class_parent() : TwstPasTreeContainer; +begin + Result := ParseDoc('pascal_class_parent'); +end; + procedure TTest_WsdlParser.no_binding_style(); var symTable : TwstPasTreeContainer; diff --git a/wst/trunk/tests/test_suite/test_rtti_filter.pas b/wst/trunk/tests/test_suite/test_rtti_filter.pas index 16b193bf0..5f9294480 100644 --- a/wst/trunk/tests/test_suite/test_rtti_filter.pas +++ b/wst/trunk/tests/test_suite/test_rtti_filter.pas @@ -52,7 +52,7 @@ type property BoolProp : Boolean read FBoolProp write FBoolProp; end; TClass_AClass = class of TClass_A; - + { TRttiExpIntegerNodeItem_Test } TRttiExpIntegerNodeItem_Test = class(TTestCase) @@ -60,7 +60,9 @@ type procedure Create_Test(); procedure Evaluate_Equal(); procedure Evaluate_Lesser(); + procedure Evaluate_LesserOrEqual(); procedure Evaluate_Greater(); + procedure Evaluate_GreaterOrEqual(); end; { TRttiExpEnumNodeItem_Test } @@ -71,7 +73,9 @@ type procedure Evaluate_Equal(); procedure Evaluate_Equal_bool(); procedure Evaluate_Lesser(); + procedure Evaluate_LesserOrEqual(); procedure Evaluate_Greater(); + procedure Evaluate_GreaterOrEqual(); end; { TRttiExpAnsiStringNodeItem_Test } @@ -203,6 +207,31 @@ begin end; end; +procedure TRttiExpIntegerNodeItem_Test.Evaluate_LesserOrEqual(); +const VAL_1 : Integer = 1210; +var + x : TRttiExpIntegerNodeItem; + t : TClass_A; +begin + x := nil; + t := TClass_A.Create(); + try + x := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoLesserOrEqual,VAL_1); + + t.IntProp := 0; + Check( x.Evaluate(t) = True ,'True'); + + t.IntProp := -VAL_1; + Check( x.Evaluate(t) = True ,'True'); + + t.IntProp := VAL_1 + 1; + Check( x.Evaluate(t) = False, 'False' ); + finally + x.Free(); + t.Free(); + end; +end; + procedure TRttiExpIntegerNodeItem_Test.Evaluate_Greater(); const VAL_1 : Integer = 1210; var @@ -225,6 +254,31 @@ begin end; end; +procedure TRttiExpIntegerNodeItem_Test.Evaluate_GreaterOrEqual(); +const VAL_1 : Integer = 1210; +var + x : TRttiExpIntegerNodeItem; + t : TClass_A; +begin + x := nil; + t := TClass_A.Create(); + try + x := TRttiExpIntegerNodeItem.Create(GetPropInfo(t,'IntProp'),nfoGreaterOrEqual,VAL_1); + + t.IntProp := 0; + Check( x.Evaluate(t) = False, 'False' ); + + t.IntProp := VAL_1; + Check( x.Evaluate(t) = True ,'True'); + + t.IntProp := VAL_1 + 1; + Check( x.Evaluate(t) = True ,'True'); + finally + x.Free(); + t.Free(); + end; +end; + { TRttiExpNode_Test } @@ -1250,6 +1304,31 @@ begin end; end; +procedure TRttiExpEnumNodeItem_Test.Evaluate_LesserOrEqual(); +const VAL_1 : TSampleEnum = SampleEnum_C; +var + x : TRttiExpEnumNodeItem; + t : TClass_A; +begin + x := nil; + t := TClass_A.Create(); + try + x := TRttiExpEnumNodeItem.Create(GetPropInfo(t,'EnumProp'),nfoLesserOrEqual,GetEnumName(TypeInfo(TSampleEnum),Ord(VAL_1))); + + t.EnumProp := SampleEnum_D; + Check( x.Evaluate(t) = False ,'False'); + + t.EnumProp := SampleEnum_B; + Check( x.Evaluate(t) = True, 'True' ); + + t.EnumProp := VAL_1; + Check( x.Evaluate(t) = True, 'True' ); + finally + x.Free(); + t.Free(); + end; +end; + procedure TRttiExpEnumNodeItem_Test.Evaluate_Greater(); const VAL_1 : TSampleEnum = SampleEnum_C; var @@ -1272,6 +1351,31 @@ begin end; end; +procedure TRttiExpEnumNodeItem_Test.Evaluate_GreaterOrEqual(); +const VAL_1 : TSampleEnum = SampleEnum_C; +var + x : TRttiExpEnumNodeItem; + t : TClass_A; +begin + x := nil; + t := TClass_A.Create(); + try + x := TRttiExpEnumNodeItem.Create(GetPropInfo(t,'EnumProp'),nfoGreaterOrEqual,GetEnumName(TypeInfo(TSampleEnum),Ord(VAL_1))); + + t.EnumProp := SampleEnum_A; + Check( x.Evaluate(t) = False ,'False'); + + t.EnumProp := SampleEnum_D; + Check( x.Evaluate(t) = True, 'True' ); + + t.EnumProp := VAL_1; + Check( x.Evaluate(t) = True, 'True' ); + finally + x.Free(); + t.Free(); + end; +end; + Initialization RegisterTest('Cursors',TRttiExpIntegerNodeItem_Test.Suite); RegisterTest('Cursors',TRttiExpEnumNodeItem_Test.Suite); diff --git a/wst/trunk/tests/test_suite/test_support.pas b/wst/trunk/tests/test_suite/test_support.pas index 794d66018..0a32e6f27 100644 --- a/wst/trunk/tests/test_suite/test_support.pas +++ b/wst/trunk/tests/test_suite/test_support.pas @@ -351,6 +351,31 @@ type procedure SetEncodedString(); end; + { TClass_A_CollectionRemotable } + + TClass_A_CollectionRemotable = class(TObjectCollectionRemotable) + private + function GetItem(AIndex : PtrInt) : TClass_A; + public + class function GetItemClass():TBaseRemotableClass;override; + function Add(): TClass_A;{$IFDEF USE_INLINE}inline;{$ENDIF} + function AddAt(const APosition : PtrInt): TClass_A;{$IFDEF USE_INLINE}inline;{$ENDIF} + property Item[AIndex:PtrInt] : TClass_A read GetItem;default; + end; + + { TTest_TObjectCollectionRemotable } + + TTest_TObjectCollectionRemotable = class(TTestCase) + published + procedure GetItemTypeInfo(); + procedure Add(); + procedure Delete(); + procedure Equal(); + procedure test_Assign(); + procedure Exchange(); + procedure IndexOf(); + end; + implementation uses Math, basex_encode; @@ -2541,7 +2566,235 @@ begin end; end; +{ TClass_A_CollectionRemotable } + +function TClass_A_CollectionRemotable.GetItem(AIndex : PtrInt) : TClass_A; +begin + Result := TClass_A(inherited Item[AIndex]); +end; + +class function TClass_A_CollectionRemotable.GetItemClass() : TBaseRemotableClass; +begin + Result := TClass_A; +end; + +function TClass_A_CollectionRemotable.Add() : TClass_A; +begin + Result := TClass_A(inherited Add()); +end; + +function TClass_A_CollectionRemotable.AddAt(const APosition : PtrInt) : TClass_A; +begin + Result := TClass_A(inherited AddAt(APosition)); +end; + +{ TTest_TObjectCollectionRemotable } + +procedure TTest_TObjectCollectionRemotable.GetItemTypeInfo(); +begin + CheckEquals( + PtrUInt(TClass_A_CollectionRemotable.GetItemClass().ClassInfo), + PtrUInt(TClass_A_CollectionRemotable.GetItemTypeInfo()) + ); +end; + +procedure TTest_TObjectCollectionRemotable.Add(); +var + ls : TClass_A_CollectionRemotable; + aa,ab : TClass_A; +begin + ls := TClass_A_CollectionRemotable.Create(); + try + aa := ls.Add(); + CheckNotNull(aa); + CheckEquals(1,ls.Length); + CheckSame(aa, ls[0]); + ab := ls.Add(); + CheckNotNull(ab); + CheckEquals(2,ls.Length); + CheckSame(ab, ls[1]); + finally + ls.Free(); + end; +end; + +procedure TTest_TObjectCollectionRemotable.Delete(); +var + ls : TClass_A_CollectionRemotable; + aa,ab : TClass_A; + ok : Boolean; +begin + ls := TClass_A_CollectionRemotable.Create(); + try + ok := False; + try + ls.Delete(-112); + except + ok := True; + end; + Check(ok); + + ok := False; + try + ls.Delete(0); + except + ok := True; + end; + Check(ok); + + ok := False; + try + ls.Delete(112); + except + ok := True; + end; + Check(ok); + + aa := ls.Add(); + ls.Delete(0); + CheckEquals(0,ls.Length); + + aa := ls.Add(); + ab := ls.Add(); + ls.Delete(0); + CheckEquals(1,ls.Length); + CheckSame(ab,ls[0]); + + FreeAndNil(ls); + ls := TClass_A_CollectionRemotable.Create(); + aa := ls.Add(); + ab := ls.Add(); + ls.Delete(1); + CheckEquals(1,ls.Length); + CheckSame(aa,ls[0]); + finally + ls.Free(); + end; +end; + +procedure TTest_TObjectCollectionRemotable.Equal(); +var + a, b : TClass_A_CollectionRemotable; +begin + b := nil; + a := TClass_A_CollectionRemotable.Create(); + try + b := TClass_A_CollectionRemotable.Create(); + Check(a.Equal(b)); + Check(b.Equal(a)); + a.Add().Val_16S := 1; + a.Add().Val_16S := 2; + Check(not a.Equal(nil)); + Check(a.Equal(a)); + Check(not a.Equal(b)); + Check(not b.Equal(a)); + + b.Add().Val_16S := 1; + Check(not a.Equal(b)); + Check(not b.Equal(a)); + b.Add().Val_16S := 2; + Check(a.Equal(b)); + Check(b.Equal(a)); + finally + b.Free(); + a.Free(); + end; +end; + +procedure TTest_TObjectCollectionRemotable.test_Assign(); + + procedure Check_List(Aa, Ab : TClass_A_CollectionRemotable); + var + k : PtrInt; + begin + if ( Aa = nil ) then begin + CheckNull(Ab); + end else begin + CheckNotNull(Ab); + CheckEquals(Aa.Length,Ab.Length); + if ( Aa.Length > 0 ) then begin + for k := 0 to Pred(Aa.Length) do begin + Check(Aa[k].Equal(Ab[k])); + end; + end; + end; + end; + +var + a, b : TClass_A_CollectionRemotable; +begin + b := nil; + a := TClass_A_CollectionRemotable.Create(); + try + b := TClass_A_CollectionRemotable.Create(); + Check_List(a,b); + a.Add().Val_16S := 1; + a.Add().Val_16S := 2; + b.Assign(a); + Check_List(a,b); + + b.Add().Val_16S := 3; + a.Assign(b); + Check_List(a,b); + + a.Clear(); + b.Assign(a); + Check_List(a,b); + finally + b.Free(); + a.Free(); + end; +end; + +procedure TTest_TObjectCollectionRemotable.Exchange(); +var + ls : TClass_A_CollectionRemotable; + a, b, c : TClass_A; +begin + ls := TClass_A_CollectionRemotable.Create(); + try + a := ls.Add(); + ls.Exchange(0,0); + CheckSame(a,ls[0]); + b := ls.Add(); + ls.Exchange(0,1); + CheckSame(a,ls[1]); + CheckSame(b,ls[0]); + c := ls.Add(); + ls.Exchange(0,2); + CheckSame(c,ls[0]); + CheckSame(b,ls[2]); + finally + ls.Free(); + end; +end; + +procedure TTest_TObjectCollectionRemotable.IndexOf(); +var + ls : TClass_A_CollectionRemotable; +begin + ls := TClass_A_CollectionRemotable.Create(); + try + CheckEquals(-1, ls.IndexOf(nil)); + ls.Add(); + CheckEquals(-1, ls.IndexOf(nil)); + CheckEquals(0, ls.IndexOf(ls[0])); + ls.Add(); + CheckEquals(-1, ls.IndexOf(nil)); + CheckEquals(0, ls.IndexOf(ls[0])); + CheckEquals(1, ls.IndexOf(ls[1])); + ls.Add(); + CheckEquals(-1, ls.IndexOf(nil)); + CheckEquals(0, ls.IndexOf(ls[0])); + CheckEquals(1, ls.IndexOf(ls[1])); + CheckEquals(2, ls.IndexOf(ls[2])); + finally + ls.Free(); + end; +end; + initialization + RegisterTest('Support',TTest_TObjectCollectionRemotable.Suite); RegisterTest('Support',TTest_TBaseComplexRemotable.Suite); RegisterTest('Support',TTest_TStringBufferRemotable.Suite); RegisterTest('Support-Date',TTest_TDateRemotable.Suite); diff --git a/wst/trunk/tests/test_suite/test_wst_cursors.pas b/wst/trunk/tests/test_suite/test_wst_cursors.pas index 5a4ab0e15..572ecfd91 100644 --- a/wst/trunk/tests/test_suite/test_wst_cursors.pas +++ b/wst/trunk/tests/test_suite/test_wst_cursors.pas @@ -34,6 +34,13 @@ type public class function GetItemClass():TBaseRemotableClass;override; end; + + { TTClass_A_CollectionRemotable } + + TTClass_A_CollectionRemotable = class(TObjectCollectionRemotable) + public + class function GetItemClass():TBaseRemotableClass;override; + end; { TClass_B } @@ -69,12 +76,21 @@ type procedure All(); end; + { TObjectCollectionRemotableCursor_Test } + + TObjectCollectionRemotableCursor_Test = class(TTestCase) + published + procedure All(); + end; + { TUtilsProcs_Test } TUtilsProcs_Test = class(TTestCase) published - procedure test_Find(); - procedure test_Filter(); + procedure test_Find_array(); + procedure test_Find_collection(); + procedure test_Filter_array(); + procedure test_Filter_collection(); end; implementation @@ -277,7 +293,7 @@ end; { TUtilsProcs_Test } -procedure TUtilsProcs_Test.test_Find(); +procedure TUtilsProcs_Test.test_Find_array(); const O_COUNT : PtrInt = 10; var ls : TTClass_A_ArrayRemotable; @@ -306,14 +322,43 @@ begin end; end; -procedure TUtilsProcs_Test.test_Filter(); +procedure TUtilsProcs_Test.test_Find_collection(); +const O_COUNT : PtrInt = 10; +var + ls : TTClass_A_CollectionRemotable; + i : PtrInt; +begin + ls := TTClass_A_CollectionRemotable.Create(); + try + CheckNull(Find(ls,'')); + CheckNull(Find(ls,'IntProp = 12')); + + ls.Add(); + CheckSame(ls[0], Find(ls,'')); + CheckSame(ls[0], Find(ls,'IntProp = 0')); + CheckNull(Find(ls,'IntProp = 12')); + + ls.Clear(); + for i := 0 to ( O_COUNT - 1 ) do + TClass_A(ls.Add()).FIntProp := i; + CheckSame(ls[0], Find(ls,'')); + CheckSame(ls[0], Find(ls,'IntProp = 0')); + CheckNull(Find(ls,Format('IntProp = %d',[2*O_COUNT]))); + for i := 0 to ( O_COUNT - 1 ) do + CheckSame(ls[i],Find(ls,Format('IntProp = %d',[i]))); + finally + ls.Free(); + end; +end; + +procedure TUtilsProcs_Test.test_Filter_array(); const O_COUNT : PtrInt = 10; var ls : TTClass_A_ArrayRemotable; i : PtrInt; crs : IObjectCursor; begin - CheckNull(Filter(nil,''), 'filter(nil) = nil'); + CheckNull(Filter(TTClass_A_ArrayRemotable(nil),''), 'filter(nil) = nil'); ls := TTClass_A_ArrayRemotable.Create(); try crs := Filter(ls,''); @@ -346,9 +391,120 @@ begin end; end; +procedure TUtilsProcs_Test.test_Filter_collection(); +const O_COUNT : PtrInt = 10; +var + ls : TTClass_A_CollectionRemotable; + i : PtrInt; + crs : IObjectCursor; +begin + CheckNull(Filter(TTClass_A_CollectionRemotable(nil),''), 'filter(nil) = nil'); + ls := TTClass_A_CollectionRemotable.Create(); + try + crs := Filter(ls,''); + Check( ( crs <> nil ) ); + crs.Reset(); + Check(not crs.MoveNext()); + + ls.Clear(); + for i := 0 to ( O_COUNT - 1 ) do + TClass_A(ls.Add()).FIntProp := i; + crs := Filter(ls,''); + Check( ( crs <> nil ) ); + crs.Reset(); + for i := 0 to ( O_COUNT - 1 ) do begin + Check(crs.MoveNext()); + CheckSame(ls[i], crs.GetCurrent()); + end; + Check(not crs.MoveNext()); + + for i := 0 to ( O_COUNT - 1 ) do begin + crs := Filter(ls,Format('IntProp = %d',[i])); + Check( ( crs <> nil ) ); + crs.Reset(); + Check(crs.MoveNext()); + CheckSame(ls[i], crs.GetCurrent()); + Check(not crs.MoveNext()); + end; + finally + ls.Free(); + end; +end; + +{ TTClass_A_CollectionRemotable } + +class function TTClass_A_CollectionRemotable.GetItemClass() : TBaseRemotableClass; +begin + Result := TClass_A; +end; + +{ TObjectCollectionRemotableCursor_Test } + +procedure TObjectCollectionRemotableCursor_Test.All(); +const O_COUNT = 100; +var + x : IObjectCursor; + ls : TObjectCollectionRemotable; + c, i : PtrInt; +begin + ls := TTClass_A_CollectionRemotable.Create(); + try + x := TObjectCollectionRemotableCursor.Create(ls); + x.Reset(); + CheckEquals(False,x.MoveNext()); + x.Reset(); + CheckEquals(False,x.MoveNext()); + CheckEquals(False,x.MoveNext()); + try + x.GetCurrent(); + Check(False); + except + on e : ECursorException do begin + // GOOD + end; + end; + + ls.Add(); + x.Reset(); + CheckEquals(True,x.MoveNext()); + CheckSame(ls[0],x.GetCurrent()); + CheckEquals(False,x.MoveNext()); + try + x.GetCurrent(); + Check(False); + except + on e : ECursorException do begin + // GOOD + end; + end; + x.Reset(); + CheckEquals(True,x.MoveNext()); + CheckSame(ls[0],x.GetCurrent()); + CheckEquals(False,x.MoveNext()); + + ls.Clear(); + for i := 0 to Pred(O_COUNT) do + TClass_A(ls.Add()).FIntProp := i; + x.Reset(); + for i := 0 to Pred(O_COUNT) do begin + CheckEquals(True,x.MoveNext()); + CheckSame(ls[i],x.GetCurrent()); + end; + CheckEquals(False,x.MoveNext()); + x.Reset(); + for i := 0 to Pred(O_COUNT) do begin + CheckEquals(True,x.MoveNext()); + CheckSame(ls[i],x.GetCurrent()); + end; + finally + ls.Free(); + end; +end; + initialization RegisterTest('Cursors',TBaseObjectArrayRemotableCursor_Test.Suite); RegisterTest('Cursors',TBaseObjectArrayRemotableFilterableCursor_Test.Suite); + RegisterTest('Cursors',TObjectCollectionRemotableCursor_Test.Suite); RegisterTest('Cursors',TUtilsProcs_Test.Suite); end. diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpi b/wst/trunk/tests/test_suite/wst_test_suite.lpi index 4f1dfcfa5..23873548a 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpi @@ -26,7 +26,7 @@ - + @@ -202,6 +202,21 @@ + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpr b/wst/trunk/tests/test_suite/wst_test_suite.lpr index ceb016960..9886dc947 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpr +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpr @@ -1,7 +1,6 @@ +{$INCLUDE wst_global.inc} program wst_test_suite; -{$mode objfpc}{$H+} - {$DEFINE UseCThreads} uses @@ -19,7 +18,8 @@ uses server_service_xmlrpc, test_parsers, wsdl_generator, xsd_generator, xsd_consts, base_json_formatter, wsdl_parser, test_support, basex_encode, test_basex_encode, json_formatter, server_service_json, test_json, -test_suite_utils, test_generators; +test_suite_utils, test_generators, test_std_cursors, test_rtti_filter, +test_wst_cursors; Const ShortOpts = 'alh'; diff --git a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi b/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi index f3616b423..b65b3c28a 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite_gui.lpi @@ -34,7 +34,7 @@ - + @@ -85,6 +85,36 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpr b/wst/trunk/tests/test_suite/wst_test_suite_gui.lpr index 7f3dd6cc0..53b4f2c4d 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite_gui.lpr +++ b/wst/trunk/tests/test_suite/wst_test_suite_gui.lpr @@ -16,7 +16,8 @@ uses server_service_xmlrpc, test_parsers, wsdl_generator, xsd_generator, xsd_consts, base_json_formatter, wsdl_parser, test_support, basex_encode, test_basex_encode, json_formatter, server_service_json, test_json, - test_suite_utils, test_generators, fpcunittestrunner; + test_suite_utils, test_generators, fpcunittestrunner, test_std_cursors, + test_rtti_filter, rtti_filters, wst_cursors, test_wst_cursors; begin Application.Initialize; diff --git a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi index fa27de801..10f4963b0 100644 --- a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi +++ b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi @@ -25,10 +25,10 @@ - + - + diff --git a/wst/trunk/type_lib_edtr/ubindingedit.lfm b/wst/trunk/type_lib_edtr/ubindingedit.lfm index 9a226cdc8..bfabb4c89 100644 --- a/wst/trunk/type_lib_edtr/ubindingedit.lfm +++ b/wst/trunk/type_lib_edtr/ubindingedit.lfm @@ -1,19 +1,24 @@ object fBindingEdit: TfBindingEdit Left = 759 - Height = 354 - Top = 90 + Height = 335 + Top = 91 Width = 400 HorzScrollBar.Page = 399 - VertScrollBar.Page = 353 + VertScrollBar.Page = 334 ActiveControl = edtName BorderStyle = bsSizeToolWin Caption = 'fBindingEdit' + ClientHeight = 335 + ClientWidth = 400 Position = poMainFormCenter + LCLVersion = '0.9.25' object Panel1: TPanel Height = 50 - Top = 304 + Top = 285 Width = 400 Align = alBottom + ClientHeight = 50 + ClientWidth = 400 TabOrder = 0 object Button1: TButton Left = 224 @@ -40,7 +45,7 @@ object fBindingEdit: TfBindingEdit end end object PageControl1: TPageControl - Height = 304 + Height = 285 Width = 400 ActivePage = TabSheet1 Align = alClient @@ -48,13 +53,14 @@ object fBindingEdit: TfBindingEdit TabOrder = 1 object TabSheet1: TTabSheet Caption = 'Interface Binding' + ClientHeight = 259 + ClientWidth = 392 object Label1: TLabel Left = 12 Height = 14 Top = 26 Width = 28 Caption = 'Name' - Color = clNone ParentColor = False end object Label2: TLabel @@ -63,14 +69,13 @@ object fBindingEdit: TfBindingEdit Top = 98 Width = 40 Caption = 'Address' - Color = clNone ParentColor = False end object edtName: TEdit Left = 12 Height = 23 Top = 50 - Width = 356 + Width = 348 Anchors = [akTop, akLeft, akRight] TabOrder = 0 Text = 'edtName' @@ -79,16 +84,17 @@ object fBindingEdit: TfBindingEdit Left = 12 Height = 23 Top = 114 - Width = 356 + Width = 348 Anchors = [akTop, akLeft, akRight] TabOrder = 1 Text = 'edtAddress' end object edtStyle: TRadioGroup Left = 12 - Height = 92 + Height = 81 Top = 165 - Width = 360 + Width = 352 + Anchors = [akTop, akLeft, akRight, akBottom] AutoFill = True Caption = ' Style ' ChildSizing.LeftRightSpacing = 6 @@ -99,6 +105,8 @@ object fBindingEdit: TfBindingEdit ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 2 + ClientHeight = 63 + ClientWidth = 348 Columns = 2 Items.Strings = ( 'Document' diff --git a/wst/trunk/type_lib_edtr/ubindingedit.lrs b/wst/trunk/type_lib_edtr/ubindingedit.lrs index 647affb86..bcedb36d4 100644 --- a/wst/trunk/type_lib_edtr/ubindingedit.lrs +++ b/wst/trunk/type_lib_edtr/ubindingedit.lrs @@ -1,37 +1,40 @@ { Ceci est un fichier ressource généré automatiquement par Lazarus } LazarusResources.Add('TfBindingEdit','FORMDATA',[ - 'TPF0'#13'TfBindingEdit'#12'fBindingEdit'#4'Left'#3#247#2#6'Height'#3'b'#1#3 - +'Top'#2'Z'#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.' - +'Page'#3'a'#1#13'ActiveControl'#7#7'edtName'#11'BorderStyle'#7#13'bsSizeTool' - +'Win'#7'Caption'#6#12'fBindingEdit'#8'Position'#7#16'poMainFormCenter'#0#6'T' - +'Panel'#6'Panel1'#6'Height'#2'2'#3'Top'#3'0'#1#5'Width'#3#144#1#5'Align'#7#8 - +'alBottom'#8'TabOrder'#2#0#0#7'TButton'#7'Button1'#4'Left'#3#224#0#6'Height' - +#2#25#3'Top'#2#10#5'Width'#2'K'#6'Action'#7#5'actOK'#7'Anchors'#11#5'akTop'#7 - +'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#7'Default'#9#8'TabOrder'#2#0#0 - +#0#7'TButton'#7'Button2'#4'Left'#3'8'#1#6'Height'#2#25#3'Top'#2#10#5'Width'#2 - +'K'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6 - +'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#1#0#0#0 - +#12'TPageControl'#12'PageControl1'#6'Height'#3'0'#1#5'Width'#3#144#1#10'Acti' - +'vePage'#7#9'TabSheet1'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2 - +#1#0#9'TTabSheet'#9'TabSheet1'#7'Caption'#6#17'Interface Binding'#0#6'TLabel' - +#6'Label1'#4'Left'#2#12#6'Height'#2#14#3'Top'#2#26#5'Width'#2#28#7'Caption'#6 - +#4'Name'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Le' - +'ft'#2#12#6'Height'#2#14#3'Top'#2'b'#5'Width'#2'('#7'Caption'#6#7'Address'#5 - +'Color'#7#6'clNone'#11'ParentColor'#8#0#0#5'TEdit'#7'edtName'#4'Left'#2#12#6 - +'Height'#2#23#3'Top'#2'2'#5'Width'#3'd'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7 - +'akRight'#0#8'TabOrder'#2#0#4'Text'#6#7'edtName'#0#0#5'TEdit'#10'edtAddress' - +#4'Left'#2#12#6'Height'#2#23#3'Top'#2'r'#5'Width'#3'd'#1#7'Anchors'#11#5'akT' - +'op'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#1#4'Text'#6#10'edtAddress'#0#0#11 - +'TRadioGroup'#8'edtStyle'#4'Left'#2#12#6'Height'#2'\'#3'Top'#3#165#0#5'Width' - +#3'h'#1#8'AutoFill'#9#7'Caption'#6#9' Style '#28'ChildSizing.LeftRightSpac' - +'ing'#2#6#28'ChildSizing.TopBottomSpacing'#2#6#29'ChildSizing.EnlargeHorizon' - +'tal'#7#24'crsHomogenousChildResize'#27'ChildSizing.EnlargeVertical'#7#24'cr' - +'sHomogenousChildResize'#28'ChildSizing.ShrinkHorizontal'#7#14'crsScaleChild' - +'s'#26'ChildSizing.ShrinkVertical'#7#14'crsScaleChilds'#18'ChildSizing.Layou' - +'t'#7#29'cclLeftToRightThenTopToBottom'#27'ChildSizing.ControlsPerLine'#2#2#7 - +'Columns'#2#2#13'Items.Strings'#1#6#8'Document'#6#3'RPC'#0#8'TabOrder'#2#2#0 - +#0#0#0#11'TActionList'#2'AL'#4'left'#2'U'#3'top'#2'd'#0#7'TAction'#5'actOK'#7 - +'Caption'#6#2'OK'#18'DisableIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8 - +'OnUpdate'#7#11'actOKUpdate'#0#0#0#0 + 'TPF0'#13'TfBindingEdit'#12'fBindingEdit'#4'Left'#3#247#2#6'Height'#3'O'#1#3 + +'Top'#2'['#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.' + +'Page'#3'N'#1#13'ActiveControl'#7#7'edtName'#11'BorderStyle'#7#13'bsSizeTool' + +'Win'#7'Caption'#6#12'fBindingEdit'#12'ClientHeight'#3'O'#1#11'ClientWidth'#3 + +#144#1#8'Position'#7#16'poMainFormCenter'#10'LCLVersion'#6#6'0.9.25'#0#6'TPa' + +'nel'#6'Panel1'#6'Height'#2'2'#3'Top'#3#29#1#5'Width'#3#144#1#5'Align'#7#8'a' + +'lBottom'#12'ClientHeight'#2'2'#11'ClientWidth'#3#144#1#8'TabOrder'#2#0#0#7 + +'TButton'#7'Button1'#4'Left'#3#224#0#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K' + +#6'Action'#7#5'actOK'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.I' + +'nnerBorder'#2#4#7'Default'#9#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Le' + +'ft'#3'8'#1#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#7'Anchors'#11#5'akTop'#7 + +'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6#6'Can' + +'cel'#11'ModalResult'#2#2#8'TabOrder'#2#1#0#0#0#12'TPageControl'#12'PageCont' + +'rol1'#6'Height'#3#29#1#5'Width'#3#144#1#10'ActivePage'#7#9'TabSheet1'#5'Ali' + +'gn'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTabSheet'#9'TabSheet' + +'1'#7'Caption'#6#17'Interface Binding'#12'ClientHeight'#3#3#1#11'ClientWidth' + +#3#136#1#0#6'TLabel'#6'Label1'#4'Left'#2#12#6'Height'#2#14#3'Top'#2#26#5'Wid' + +'th'#2#28#7'Caption'#6#4'Name'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'L' + +'eft'#2#12#6'Height'#2#14#3'Top'#2'b'#5'Width'#2'('#7'Caption'#6#7'Address' + +#11'ParentColor'#8#0#0#5'TEdit'#7'edtName'#4'Left'#2#12#6'Height'#2#23#3'Top' + +#2'2'#5'Width'#3'\'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrd' + +'er'#2#0#4'Text'#6#7'edtName'#0#0#5'TEdit'#10'edtAddress'#4'Left'#2#12#6'Hei' + +'ght'#2#23#3'Top'#2'r'#5'Width'#3'\'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'ak' + +'Right'#0#8'TabOrder'#2#1#4'Text'#6#10'edtAddress'#0#0#11'TRadioGroup'#8'edt' + +'Style'#4'Left'#2#12#6'Height'#2'Q'#3'Top'#3#165#0#5'Width'#3'`'#1#7'Anchors' + +#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#8'AutoFill'#9#7'Caption'#6#9 + +' Style '#28'ChildSizing.LeftRightSpacing'#2#6#28'ChildSizing.TopBottomSpa' + +'cing'#2#6#29'ChildSizing.EnlargeHorizontal'#7#24'crsHomogenousChildResize' + +#27'ChildSizing.EnlargeVertical'#7#24'crsHomogenousChildResize'#28'ChildSizi' + +'ng.ShrinkHorizontal'#7#14'crsScaleChilds'#26'ChildSizing.ShrinkVertical'#7 + +#14'crsScaleChilds'#18'ChildSizing.Layout'#7#29'cclLeftToRightThenTopToBotto' + +'m'#27'ChildSizing.ControlsPerLine'#2#2#12'ClientHeight'#2'?'#11'ClientWidth' + +#3'\'#1#7'Columns'#2#2#13'Items.Strings'#1#6#8'Document'#6#3'RPC'#0#8'TabOrd' + +'er'#2#2#0#0#0#0#11'TActionList'#2'AL'#4'left'#2'U'#3'top'#2'd'#0#7'TAction' + +#5'actOK'#7'Caption'#6#2'OK'#18'DisableIfNoHandler'#9#9'OnExecute'#7#12'actO' + +'KExecute'#8'OnUpdate'#7#11'actOKUpdate'#0#0#0#0 ]); diff --git a/wst/trunk/type_lib_edtr/ufarrayedit.lfm b/wst/trunk/type_lib_edtr/ufarrayedit.lfm index af8404d11..407ea6e8e 100644 --- a/wst/trunk/type_lib_edtr/ufarrayedit.lfm +++ b/wst/trunk/type_lib_edtr/ufarrayedit.lfm @@ -1,19 +1,24 @@ object fArrayEdit: TfArrayEdit Left = 327 - Height = 361 - Top = 131 + Height = 375 + Top = 132 Width = 392 HorzScrollBar.Page = 391 - VertScrollBar.Page = 360 + VertScrollBar.Page = 374 ActiveControl = Button1 BorderStyle = bsSizeToolWin Caption = 'fArrayEdit' + ClientHeight = 375 + ClientWidth = 392 Position = poMainFormCenter + LCLVersion = '0.9.25' object Panel1: TPanel Height = 50 - Top = 311 + Top = 325 Width = 392 Align = alBottom + ClientHeight = 50 + ClientWidth = 392 TabOrder = 0 object Button1: TButton Left = 216 @@ -39,7 +44,7 @@ object fArrayEdit: TfArrayEdit end end object PageControl1: TPageControl - Height = 311 + Height = 325 Width = 392 ActivePage = TabSheet1 Align = alClient @@ -47,46 +52,45 @@ object fArrayEdit: TfArrayEdit TabOrder = 1 object TabSheet1: TTabSheet Caption = 'Array definition' + ClientHeight = 299 + ClientWidth = 384 object Label1: TLabel - Left = 19 + Left = 20 Height = 14 Top = 21 Width = 28 Caption = 'Name' - Color = clNone ParentColor = False end object Label2: TLabel - Left = 19 + Left = 20 Height = 14 Top = 102 Width = 66 Caption = 'Element Type' - Color = clNone ParentColor = False end object Label3: TLabel - Left = 19 + Left = 20 Height = 14 Top = 170 Width = 69 Caption = 'Element Name' - Color = clNone ParentColor = False end object edtName: TEdit Left = 20 Height = 23 Top = 42 - Width = 345 + Width = 337 Anchors = [akTop, akLeft, akRight] TabOrder = 0 end object edtElementType: TComboBox - Left = 19 + Left = 20 Height = 21 Top = 122 - Width = 345 + Width = 337 Anchors = [akTop, akLeft, akRight] AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] ItemHeight = 13 @@ -95,22 +99,30 @@ object fArrayEdit: TfArrayEdit TabOrder = 1 end object edtEmbedded: TCheckBox - Left = 19 - Height = 13 - Top = 242 - Width = 71 - Caption = 'Embedded' - TabOrder = 2 + Left = 20 + Height = 19 + Top = 226 + Width = 337 + Caption = 'Embedded ( items are expanded directly in the enclosing element )' + TabOrder = 3 end object edtElementName: TEdit - Left = 19 + Left = 20 Height = 23 Top = 186 - Width = 345 + Width = 337 Anchors = [akTop, akLeft, akRight] - TabOrder = 3 + TabOrder = 2 Text = 'Item' end + object edtCollection: TCheckBox + Left = 20 + Height = 19 + Top = 258 + Width = 352 + Caption = 'Collection ( Pascal type will derive from TObjectCollectionRemotable )' + TabOrder = 4 + end end end object AL: TActionList diff --git a/wst/trunk/type_lib_edtr/ufarrayedit.lrs b/wst/trunk/type_lib_edtr/ufarrayedit.lrs index 131bfeee4..7e1638fdf 100644 --- a/wst/trunk/type_lib_edtr/ufarrayedit.lrs +++ b/wst/trunk/type_lib_edtr/ufarrayedit.lrs @@ -1,36 +1,41 @@ { Ceci est un fichier ressource généré automatiquement par Lazarus } LazarusResources.Add('TfArrayEdit','FORMDATA',[ - 'TPF0'#11'TfArrayEdit'#10'fArrayEdit'#4'Left'#3'G'#1#6'Height'#3'i'#1#3'Top'#3 - +#131#0#5'Width'#3#136#1#18'HorzScrollBar.Page'#3#135#1#18'VertScrollBar.Page' - +#3'h'#1#13'ActiveControl'#7#7'Button1'#11'BorderStyle'#7#13'bsSizeToolWin'#7 - +'Caption'#6#10'fArrayEdit'#8'Position'#7#16'poMainFormCenter'#0#6'TPanel'#6 - +'Panel1'#6'Height'#2'2'#3'Top'#3'7'#1#5'Width'#3#136#1#5'Align'#7#8'alBottom' - +#8'TabOrder'#2#0#0#7'TButton'#7'Button1'#4'Left'#3#216#0#6'Height'#2#25#3'To' - +'p'#2#9#5'Width'#2'K'#6'Action'#7#5'actOK'#7'Anchors'#11#5'akTop'#7'akRight' - +#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#0#0#0#7'TButton'#7'Button' - +'2'#4'Left'#3'0'#1#6'Height'#2#25#3'Top'#2#9#5'Width'#2'K'#7'Anchors'#11#5'a' - +'kTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Caption' - +#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#1#0#0#0#12'TPageControl'#12'P' - +'ageControl1'#6'Height'#3'7'#1#5'Width'#3#136#1#10'ActivePage'#7#9'TabSheet1' - +#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTabSheet'#9'Tab' - +'Sheet1'#7'Caption'#6#16'Array definition'#0#6'TLabel'#6'Label1'#4'Left'#2#19 - +#6'Height'#2#14#3'Top'#2#21#5'Width'#2#28#7'Caption'#6#4'Name'#5'Color'#7#6 - +'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#19#6'Height'#2 - +#14#3'Top'#2'f'#5'Width'#2'B'#7'Caption'#6#12'Element Type'#5'Color'#7#6'clN' - +'one'#11'ParentColor'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2#19#6'Height'#2#14#3 - +'Top'#3#170#0#5'Width'#2'E'#7'Caption'#6#12'Element Name'#5'Color'#7#6'clNon' - +'e'#11'ParentColor'#8#0#0#5'TEdit'#7'edtName'#4'Left'#2#20#6'Height'#2#23#3 - +'Top'#2'*'#5'Width'#3'Y'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'T' - +'abOrder'#2#0#0#0#9'TComboBox'#14'edtElementType'#4'Left'#2#19#6'Height'#2#21 - +#3'Top'#2'z'#5'Width'#3'Y'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#16 - +'AutoCompleteText'#11#22'cbactEndOfLineComplete'#20'cbactSearchAscending'#0 - +#10'ItemHeight'#2#13#9'MaxLength'#2#0#5'Style'#7#14'csDropDownList'#8'TabOrd' - +'er'#2#1#0#0#9'TCheckBox'#11'edtEmbedded'#4'Left'#2#19#6'Height'#2#13#3'Top' - +#3#242#0#5'Width'#2'G'#7'Caption'#6#8'Embedded'#8'TabOrder'#2#2#0#0#5'TEdit' - +#14'edtElementName'#4'Left'#2#19#6'Height'#2#23#3'Top'#3#186#0#5'Width'#3'Y' - +#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#3#4'Text'#6#4 - +'Item'#0#0#0#0#11'TActionList'#2'AL'#4'left'#3#215#0#3'top'#3#185#0#0#7'TAct' - +'ion'#5'actOK'#7'Caption'#6#2'OK'#18'DisableIfNoHandler'#9#9'OnExecute'#7#12 - +'actOKExecute'#8'OnUpdate'#7#11'actOKUpdate'#0#0#0#0 + 'TPF0'#11'TfArrayEdit'#10'fArrayEdit'#4'Left'#3'G'#1#6'Height'#3'w'#1#3'Top'#3 + +#132#0#5'Width'#3#136#1#18'HorzScrollBar.Page'#3#135#1#18'VertScrollBar.Page' + +#3'v'#1#13'ActiveControl'#7#7'Button1'#11'BorderStyle'#7#13'bsSizeToolWin'#7 + +'Caption'#6#10'fArrayEdit'#12'ClientHeight'#3'w'#1#11'ClientWidth'#3#136#1#8 + +'Position'#7#16'poMainFormCenter'#10'LCLVersion'#6#6'0.9.25'#0#6'TPanel'#6'P' + +'anel1'#6'Height'#2'2'#3'Top'#3'E'#1#5'Width'#3#136#1#5'Align'#7#8'alBottom' + +#12'ClientHeight'#2'2'#11'ClientWidth'#3#136#1#8'TabOrder'#2#0#0#7'TButton'#7 + +'Button1'#4'Left'#3#216#0#6'Height'#2#25#3'Top'#2#9#5'Width'#2'K'#6'Action'#7 + +#5'actOK'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2 + +#4#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Left'#3'0'#1#6'Height'#2#25#3 + +'Top'#2#9#5'Width'#2'K'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing' + +'.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8 + +'TabOrder'#2#1#0#0#0#12'TPageControl'#12'PageControl1'#6'Height'#3'E'#1#5'Wi' + +'dth'#3#136#1#10'ActivePage'#7#9'TabSheet1'#5'Align'#7#8'alClient'#8'TabInde' + +'x'#2#0#8'TabOrder'#2#1#0#9'TTabSheet'#9'TabSheet1'#7'Caption'#6#16'Array de' + +'finition'#12'ClientHeight'#3'+'#1#11'ClientWidth'#3#128#1#0#6'TLabel'#6'Lab' + +'el1'#4'Left'#2#20#6'Height'#2#14#3'Top'#2#21#5'Width'#2#28#7'Caption'#6#4'N' + +'ame'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#20#6'Height'#2#14#3 + +'Top'#2'f'#5'Width'#2'B'#7'Caption'#6#12'Element Type'#11'ParentColor'#8#0#0 + +#6'TLabel'#6'Label3'#4'Left'#2#20#6'Height'#2#14#3'Top'#3#170#0#5'Width'#2'E' + +#7'Caption'#6#12'Element Name'#11'ParentColor'#8#0#0#5'TEdit'#7'edtName'#4'L' + +'eft'#2#20#6'Height'#2#23#3'Top'#2'*'#5'Width'#3'Q'#1#7'Anchors'#11#5'akTop' + +#6'akLeft'#7'akRight'#0#8'TabOrder'#2#0#0#0#9'TComboBox'#14'edtElementType'#4 + +'Left'#2#20#6'Height'#2#21#3'Top'#2'z'#5'Width'#3'Q'#1#7'Anchors'#11#5'akTop' + +#6'akLeft'#7'akRight'#0#16'AutoCompleteText'#11#22'cbactEndOfLineComplete'#20 + +'cbactSearchAscending'#0#10'ItemHeight'#2#13#9'MaxLength'#2#0#5'Style'#7#14 + +'csDropDownList'#8'TabOrder'#2#1#0#0#9'TCheckBox'#11'edtEmbedded'#4'Left'#2 + +#20#6'Height'#2#19#3'Top'#3#226#0#5'Width'#3'Q'#1#7'Caption'#6'AEmbedded ( i' + +'tems are expanded directly in the enclosing element )'#8'TabOrder'#2#3#0#0#5 + +'TEdit'#14'edtElementName'#4'Left'#2#20#6'Height'#2#23#3'Top'#3#186#0#5'Widt' + +'h'#3'Q'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#2#4'T' + +'ext'#6#4'Item'#0#0#9'TCheckBox'#13'edtCollection'#4'Left'#2#20#6'Height'#2 + +#19#3'Top'#3#2#1#5'Width'#3'`'#1#7'Caption'#6'FCollection ( Pascal type will' + +' derive from TObjectCollectionRemotable )'#8'TabOrder'#2#4#0#0#0#0#11'TActi' + +'onList'#2'AL'#4'left'#3#215#0#3'top'#3#185#0#0#7'TAction'#5'actOK'#7'Captio' + +'n'#6#2'OK'#18'DisableIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpd' + +'ate'#7#11'actOKUpdate'#0#0#0#0 ]); diff --git a/wst/trunk/type_lib_edtr/ufarrayedit.pas b/wst/trunk/type_lib_edtr/ufarrayedit.pas index 14d6a789f..b0386f5ff 100644 --- a/wst/trunk/type_lib_edtr/ufarrayedit.pas +++ b/wst/trunk/type_lib_edtr/ufarrayedit.pas @@ -18,6 +18,7 @@ type AL : TActionList; Button1 : TButton; Button2 : TButton; + edtCollection : TCheckBox; edtEmbedded : TCheckBox; edtElementName : TEdit; edtElementType : TComboBox; @@ -67,8 +68,22 @@ begin end; procedure TfArrayEdit.actOKExecute(Sender : TObject); +var + eltType : TPasType; + ok : Boolean; begin - ModalResult := mrOK; + ok := True; + if edtCollection.Checked then begin + eltType := edtElementType.Items.Objects[edtElementType.ItemIndex] as TPasType; + if eltType.InheritsFrom(TPasUnresolvedTypeRef) then + eltType := FSymbolTable.FindElement(FSymbolTable.GetExternalName(eltType)) as TPasType; + if eltType.InheritsFrom(TPasNativeSimpleType) or eltType.InheritsFrom(TPasNativeSimpleContentClassType) then begin + ok := False; + ShowMessage('Collections for simple types are not supported.'); + end; + end; + if ok then + ModalResult := mrOK; end; procedure TfArrayEdit.LoadFromObject(); @@ -87,6 +102,7 @@ begin edtElementName.Text := FSymbolTable.GetArrayItemExternalName(FObject); edtElementType.ItemIndex := edtElementType.Items.IndexOf(FSymbolTable.GetExternalName(FObject.ElType)); edtEmbedded.Checked := ( FSymbolTable.GetArrayStyle(FObject) = asEmbeded ); + edtCollection.Checked:= FSymbolTable.IsCollection(FObject); end else begin Self.Caption := 'NewArray'; end; @@ -129,6 +145,8 @@ begin FSymbolTable.SetArrayStyle(locObj,arrStyle); FSymbolTable.SetArrayItemExternalName(locObj,eltExtName); end; + if ( edtCollection.Checked <> FSymbolTable.IsCollection(FObject) ) then + FSymbolTable.SetCollectionFlag(FObject,edtCollection.Checked); FSymbolTable.RegisterExternalAlias(locObj,typExtName); end; diff --git a/wst/trunk/type_lib_edtr/ufclassedit.lfm b/wst/trunk/type_lib_edtr/ufclassedit.lfm index 8f67113e9..d0f78c91e 100644 --- a/wst/trunk/type_lib_edtr/ufclassedit.lfm +++ b/wst/trunk/type_lib_edtr/ufclassedit.lfm @@ -11,6 +11,7 @@ object fClassEdit: TfClassEdit ClientHeight = 547 ClientWidth = 518 Position = poDesktopCenter + LCLVersion = '0.9.25' object Panel1: TPanel Height = 50 Top = 497 diff --git a/wst/trunk/type_lib_edtr/ufclassedit.lrs b/wst/trunk/type_lib_edtr/ufclassedit.lrs index a4e8405ce..3f03c31f0 100644 --- a/wst/trunk/type_lib_edtr/ufclassedit.lrs +++ b/wst/trunk/type_lib_edtr/ufclassedit.lrs @@ -5,54 +5,55 @@ LazarusResources.Add('TfClassEdit','FORMDATA',[ +'*'#5'Width'#3#6#2#18'HorzScrollBar.Page'#3#5#2#18'VertScrollBar.Page'#3'"'#2 +#13'ActiveControl'#7#7'Button1'#11'BorderStyle'#7#13'bsSizeToolWin'#7'Captio' +'n'#6#10'fClassEdit'#12'ClientHeight'#3'#'#2#11'ClientWidth'#3#6#2#8'Positio' - +'n'#7#15'poDesktopCenter'#0#6'TPanel'#6'Panel1'#6'Height'#2'2'#3'Top'#3#241#1 - +#5'Width'#3#6#2#5'Align'#7#8'alBottom'#12'ClientHeight'#2'2'#11'ClientWidth' - +#3#6#2#8'TabOrder'#2#0#0#7'TButton'#7'Button1'#4'Left'#3#174#1#6'Height'#2#25 - +#3'Top'#2#10#5'Width'#2'K'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpac' - +'ing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2 - +#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Left'#3'T'#1#6'Height'#2#25#3'T' - +'op'#2#10#5'Width'#2'K'#6'Action'#7#5'actOK'#7'Anchors'#11#5'akTop'#7'akRigh' - +'t'#0#25'BorderSpacing.InnerBorder'#2#4#7'Default'#9#8'TabOrder'#2#1#0#0#0#12 - +'TPageControl'#2'PC'#6'Height'#3#241#1#5'Width'#3#6#2#10'ActivePage'#7#9'Tab' - +'Sheet1'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTabShee' - +'t'#9'TabSheet1'#7'Caption'#6#15'Compound Object'#12'ClientHeight'#3#215#1#11 - +'ClientWidth'#3#254#1#0#6'TLabel'#6'Label1'#4'Left'#2#4#6'Height'#2#14#3'Top' - +#2#18#5'Width'#2#28#7'Caption'#6#4'Name'#11'ParentColor'#8#0#0#6'TLabel'#6'L' - +'abel2'#4'Left'#2#4#6'Height'#2#14#3'Top'#2';'#5'Width'#2'C'#7'Caption'#6#14 - +'Inheritts from'#11'ParentColor'#8#0#0#5'TEdit'#7'edtName'#4'Left'#2'\'#6'He' - +'ight'#2#23#3'Top'#2#18#5'Width'#3#150#1#7'Anchors'#11#5'akTop'#6'akLeft'#7 - +'akRight'#0#8'TabOrder'#2#0#0#0#9'TGroupBox'#9'GroupBox1'#4'Left'#2#4#6'Heig' - +'ht'#3'8'#1#3'Top'#2'b'#5'Width'#3#239#1#7'Anchors'#11#5'akTop'#6'akLeft'#7 - +'akRight'#8'akBottom'#0#7'Caption'#6#14' Properties '#12'ClientHeight'#3'&' - +#1#11'ClientWidth'#3#235#1#8'TabOrder'#2#1#0#9'TListView'#7'edtProp'#6'Heigh' - +'t'#3'&'#1#5'Width'#3#235#1#5'Align'#7#8'alClient'#11'BorderWidth'#2#2#7'Col' - +'umns'#14#1#8'AutoSize'#9#7'Caption'#6#4'Name'#5'Width'#3#210#0#0#1#7'Captio' - +'n'#6#4'Type'#5'Width'#3#200#0#0#1#7'Caption'#6#9'Attribute'#5'Width'#2'<'#0 - +#0#9'PopupMenu'#7#10'PopupMenu1'#9'RowSelect'#9#8'TabOrder'#2#0#9'ViewStyle' - +#7#8'vsReport'#10'OnDblClick'#7#15'edtPropDblClick'#0#0#0#7'TButton'#7'Butto' - +'n3'#4'Left'#2#4#6'Height'#2#25#3'Top'#3#165#1#5'Width'#2'd'#6'Action'#7#10 - +'actPropAdd'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#25'BorderSpacing.InnerBor' - +'der'#2#4#8'TabOrder'#2#2#0#0#7'TButton'#7'Button4'#4'Left'#2't'#6'Height'#2 - +#25#3'Top'#3#165#1#5'Width'#2'd'#6'Action'#7#11'actPropEdit'#7'Anchors'#11#6 - +'akLeft'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#3#0#0 - +#7'TButton'#7'Button5'#4'Left'#3#228#0#6'Height'#2#25#3'Top'#3#165#1#5'Width' - +#2'd'#6'Action'#7#13'actPropDelete'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#25 - +'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#4#0#0#9'TComboBox'#9'edtParent' - +#4'Left'#2'\'#6'Height'#2#21#3'Top'#2':'#5'Width'#3#150#1#7'Anchors'#11#5'ak' - +'Top'#6'akLeft'#7'akRight'#0#16'AutoCompleteText'#11#22'cbactEndOfLineComple' - +'te'#20'cbactSearchAscending'#0#10'ItemHeight'#2#13#9'MaxLength'#2#0#5'Style' - +#7#14'csDropDownList'#8'TabOrder'#2#5#0#0#0#0#11'TActionList'#11'ActionList1' - +#4'left'#3#232#0#3'top'#3#200#0#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18 - +'DisableIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actO' - +'KUpdate'#0#0#7'TAction'#10'actPropAdd'#7'Caption'#6#12'New Property'#18'Dis' - +'ableIfNoHandler'#9#9'OnExecute'#7#17'actPropAddExecute'#0#0#7'TAction'#11'a' - +'ctPropEdit'#7'Caption'#6#13'Edit Property'#18'DisableIfNoHandler'#9#9'OnExe' - +'cute'#7#18'actPropEditExecute'#8'OnUpdate'#7#17'actPropEditUpdate'#0#0#7'TA' - +'ction'#13'actPropDelete'#7'Caption'#6#15'Delete Property'#18'DisableIfNoHan' - +'dler'#9#9'OnExecute'#7#20'actPropDeleteExecute'#8'OnUpdate'#7#17'actPropEdi' - +'tUpdate'#0#0#0#10'TPopupMenu'#10'PopupMenu1'#4'left'#2'i'#3'top'#3#186#0#0#9 - +'TMenuItem'#9'MenuItem1'#6'Action'#7#10'actPropAdd'#7'OnClick'#7#17'actPropA' - +'ddExecute'#0#0#9'TMenuItem'#9'MenuItem2'#6'Action'#7#11'actPropEdit'#7'OnCl' - +'ick'#7#18'actPropEditExecute'#0#0#9'TMenuItem'#9'MenuItem3'#6'Action'#7#13 - +'actPropDelete'#7'OnClick'#7#20'actPropDeleteExecute'#0#0#0#0 + +'n'#7#15'poDesktopCenter'#10'LCLVersion'#6#6'0.9.25'#0#6'TPanel'#6'Panel1'#6 + +'Height'#2'2'#3'Top'#3#241#1#5'Width'#3#6#2#5'Align'#7#8'alBottom'#12'Client' + +'Height'#2'2'#11'ClientWidth'#3#6#2#8'TabOrder'#2#0#0#7'TButton'#7'Button1'#4 + +'Left'#3#174#1#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#7'Anchors'#11#5'akTo' + +'p'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6#6 + +'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Lef' + +'t'#3'T'#1#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#6'Action'#7#5'actOK'#7'A' + +'nchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#7'Defaul' + +'t'#9#8'TabOrder'#2#1#0#0#0#12'TPageControl'#2'PC'#6'Height'#3#241#1#5'Width' + +#3#6#2#10'ActivePage'#7#9'TabSheet1'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8 + +'TabOrder'#2#1#0#9'TTabSheet'#9'TabSheet1'#7'Caption'#6#15'Compound Object' + +#12'ClientHeight'#3#215#1#11'ClientWidth'#3#254#1#0#6'TLabel'#6'Label1'#4'Le' + +'ft'#2#4#6'Height'#2#14#3'Top'#2#18#5'Width'#2#28#7'Caption'#6#4'Name'#11'Pa' + +'rentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#4#6'Height'#2#14#3'Top'#2';' + +#5'Width'#2'C'#7'Caption'#6#14'Inheritts from'#11'ParentColor'#8#0#0#5'TEdit' + +#7'edtName'#4'Left'#2'\'#6'Height'#2#23#3'Top'#2#18#5'Width'#3#150#1#7'Ancho' + +'rs'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#0#0#0#9'TGroupBox'#9'G' + +'roupBox1'#4'Left'#2#4#6'Height'#3'8'#1#3'Top'#2'b'#5'Width'#3#239#1#7'Ancho' + +'rs'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#7'Caption'#6#14' Proper' + +'ties '#12'ClientHeight'#3'&'#1#11'ClientWidth'#3#235#1#8'TabOrder'#2#1#0#9 + +'TListView'#7'edtProp'#6'Height'#3'&'#1#5'Width'#3#235#1#5'Align'#7#8'alClie' + +'nt'#11'BorderWidth'#2#2#7'Columns'#14#1#8'AutoSize'#9#7'Caption'#6#4'Name'#5 + +'Width'#3#210#0#0#1#7'Caption'#6#4'Type'#5'Width'#3#200#0#0#1#7'Caption'#6#9 + +'Attribute'#5'Width'#2'<'#0#0#9'PopupMenu'#7#10'PopupMenu1'#9'RowSelect'#9#8 + +'TabOrder'#2#0#9'ViewStyle'#7#8'vsReport'#10'OnDblClick'#7#15'edtPropDblClic' + +'k'#0#0#0#7'TButton'#7'Button3'#4'Left'#2#4#6'Height'#2#25#3'Top'#3#165#1#5 + +'Width'#2'd'#6'Action'#7#10'actPropAdd'#7'Anchors'#11#6'akLeft'#8'akBottom'#0 + +#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#2#0#0#7'TButton'#7'Button4' + +#4'Left'#2't'#6'Height'#2#25#3'Top'#3#165#1#5'Width'#2'd'#6'Action'#7#11'act' + +'PropEdit'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#25'BorderSpacing.InnerBorde' + +'r'#2#4#8'TabOrder'#2#3#0#0#7'TButton'#7'Button5'#4'Left'#3#228#0#6'Height'#2 + +#25#3'Top'#3#165#1#5'Width'#2'd'#6'Action'#7#13'actPropDelete'#7'Anchors'#11 + +#6'akLeft'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#4#0 + +#0#9'TComboBox'#9'edtParent'#4'Left'#2'\'#6'Height'#2#21#3'Top'#2':'#5'Width' + +#3#150#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#16'AutoCompleteText' + +#11#22'cbactEndOfLineComplete'#20'cbactSearchAscending'#0#10'ItemHeight'#2#13 + +#9'MaxLength'#2#0#5'Style'#7#14'csDropDownList'#8'TabOrder'#2#5#0#0#0#0#11'T' + +'ActionList'#11'ActionList1'#4'left'#3#232#0#3'top'#3#200#0#0#7'TAction'#5'a' + +'ctOK'#7'Caption'#6#2'OK'#18'DisableIfNoHandler'#9#9'OnExecute'#7#12'actOKEx' + +'ecute'#8'OnUpdate'#7#11'actOKUpdate'#0#0#7'TAction'#10'actPropAdd'#7'Captio' + +'n'#6#12'New Property'#18'DisableIfNoHandler'#9#9'OnExecute'#7#17'actPropAdd' + +'Execute'#0#0#7'TAction'#11'actPropEdit'#7'Caption'#6#13'Edit Property'#18'D' + +'isableIfNoHandler'#9#9'OnExecute'#7#18'actPropEditExecute'#8'OnUpdate'#7#17 + +'actPropEditUpdate'#0#0#7'TAction'#13'actPropDelete'#7'Caption'#6#15'Delete ' + +'Property'#18'DisableIfNoHandler'#9#9'OnExecute'#7#20'actPropDeleteExecute'#8 + +'OnUpdate'#7#17'actPropEditUpdate'#0#0#0#10'TPopupMenu'#10'PopupMenu1'#4'lef' + +'t'#2'i'#3'top'#3#186#0#0#9'TMenuItem'#9'MenuItem1'#6'Action'#7#10'actPropAd' + +'d'#7'OnClick'#7#17'actPropAddExecute'#0#0#9'TMenuItem'#9'MenuItem2'#6'Actio' + +'n'#7#11'actPropEdit'#7'OnClick'#7#18'actPropEditExecute'#0#0#9'TMenuItem'#9 + +'MenuItem3'#6'Action'#7#13'actPropDelete'#7'OnClick'#7#20'actPropDeleteExecu' + +'te'#0#0#0#0 ]); diff --git a/wst/trunk/type_lib_edtr/ufclassedit.pas b/wst/trunk/type_lib_edtr/ufclassedit.pas index 1d5077008..69dcc6273 100644 --- a/wst/trunk/type_lib_edtr/ufclassedit.pas +++ b/wst/trunk/type_lib_edtr/ufclassedit.pas @@ -298,7 +298,8 @@ begin trueParent := TPasNativeSimpleType(trueParent).ExtendableType; end; end else begin - trueParent := nil; + //trueParent := nil; + trueParent := FSymbolTable.FindElementNS('TBaseComplexRemotable',sXSD_NS) as TPasType; end; if ( trueParent <> FOldAncestor ) then begin if ( FOldAncestor <> nil ) then diff --git a/wst/trunk/type_lib_edtr/uinterfaceedit.lfm b/wst/trunk/type_lib_edtr/uinterfaceedit.lfm index 31bbd66c6..ab0597882 100644 --- a/wst/trunk/type_lib_edtr/uinterfaceedit.lfm +++ b/wst/trunk/type_lib_edtr/uinterfaceedit.lfm @@ -1,7 +1,7 @@ object fInterfaceEdit: TfInterfaceEdit Left = 361 Height = 564 - Top = 373 + Top = 293 Width = 531 HorzScrollBar.Page = 530 VertScrollBar.Page = 563 @@ -12,6 +12,7 @@ object fInterfaceEdit: TfInterfaceEdit ClientWidth = 531 OnCreate = FormCreate Position = poDesktopCenter + LCLVersion = '0.9.25' object Panel1: TPanel Height = 50 Top = 514 diff --git a/wst/trunk/type_lib_edtr/uinterfaceedit.lrs b/wst/trunk/type_lib_edtr/uinterfaceedit.lrs index 9f3771a0b..d4f39d138 100644 --- a/wst/trunk/type_lib_edtr/uinterfaceedit.lrs +++ b/wst/trunk/type_lib_edtr/uinterfaceedit.lrs @@ -2,56 +2,56 @@ LazarusResources.Add('TfInterfaceEdit','FORMDATA',[ 'TPF0'#15'TfInterfaceEdit'#14'fInterfaceEdit'#4'Left'#3'i'#1#6'Height'#3'4'#2 - +#3'Top'#3'u'#1#5'Width'#3#19#2#18'HorzScrollBar.Page'#3#18#2#18'VertScrollBa' + +#3'Top'#3'%'#1#5'Width'#3#19#2#18'HorzScrollBar.Page'#3#18#2#18'VertScrollBa' +'r.Page'#3'3'#2#13'ActiveControl'#7#7'Button1'#11'BorderStyle'#7#13'bsSizeTo' +'olWin'#7'Caption'#6#14'fInterfaceEdit'#12'ClientHeight'#3'4'#2#11'ClientWid' - +'th'#3#19#2#8'OnCreate'#7#10'FormCreate'#8'Position'#7#15'poDesktopCenter'#0 - +#6'TPanel'#6'Panel1'#6'Height'#2'2'#3'Top'#3#2#2#5'Width'#3#19#2#5'Align'#7#8 - +'alBottom'#12'ClientHeight'#2'2'#11'ClientWidth'#3#19#2#8'TabOrder'#2#0#0#7 - +'TButton'#7'Button1'#4'Left'#3#180#1#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K' - +#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Can' - +'cel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#0#0#0#7'TBu' - +'tton'#7'Button2'#4'Left'#3'Z'#1#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#6 - +'Action'#7#5'actOK'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.Inn' - +'erBorder'#2#4#7'Default'#9#8'TabOrder'#2#1#0#0#0#12'TPageControl'#2'PC'#6'H' - +'eight'#3#2#2#5'Width'#3#19#2#10'ActivePage'#7#9'TabSheet1'#5'Align'#7#8'alC' - +'lient'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTabSheet'#9'TabSheet1'#7'Captio' - +'n'#6#20'Interface definition'#12'ClientHeight'#3#232#1#11'ClientWidth'#3#11 - +#2#0#6'TLabel'#6'Label1'#4'Left'#2#20#6'Height'#2#14#3'Top'#2#26#5'Width'#2 - +#28#7'Caption'#6#4'Name'#11'ParentColor'#8#0#0#5'TEdit'#7'edtName'#4'Left'#2 - +'<'#6'Height'#2#23#3'Top'#2#26#5'Width'#3#187#1#7'Anchors'#11#5'akTop'#6'akL' - +'eft'#7'akRight'#0#8'TabOrder'#2#0#0#0#9'TGroupBox'#9'GroupBox1'#4'Left'#2#20 - +#6'Height'#3'p'#1#3'Top'#2'J'#5'Width'#3#228#1#7'Anchors'#11#5'akTop'#6'akLe' - +'ft'#7'akRight'#8'akBottom'#0#7'Caption'#6#11' Methods '#12'ClientHeight'#3 - +'^'#1#11'ClientWidth'#3#224#1#8'TabOrder'#2#1#0#9'TTreeView'#10'trvMethods'#6 - +'Height'#3'^'#1#5'Width'#3#224#1#5'Align'#7#8'alClient'#17'DefaultItemHeight' - +#2#15#9'PopupMenu'#7#10'PopupMenu1'#8'TabOrder'#2#0#0#0#0#7'TButton'#7'Butto' - +'n3'#4'Left'#2#20#6'Height'#2#25#3'Top'#3#194#1#5'Width'#2'c'#6'Action'#7#12 - +'actNewMethod'#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#2#0#0#7'TButt' - +'on'#7'Button4'#4'Left'#3#132#0#6'Height'#2#25#3'Top'#3#194#1#5'Width'#2'k'#6 - +'Action'#7#18'actUpdateOperation'#25'BorderSpacing.InnerBorder'#2#4#8'TabOrd' - +'er'#2#3#0#0#7'TButton'#7'Button5'#4'Left'#3#252#0#6'Height'#2#25#3'Top'#3 - +#194#1#5'Width'#2'h'#6'Action'#7#18'actDeleteOperation'#25'BorderSpacing.Inn' - +'erBorder'#2#4#8'TabOrder'#2#4#0#0#7'TButton'#7'Button6'#4'Left'#3#140#1#6'H' - +'eight'#2#25#3'Top'#3#194#1#5'Width'#2'k'#6'Action'#7#14'actBindingEdit'#7'A' - +'nchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#8'TabOrd' - +'er'#2#5#0#0#0#0#11'TActionList'#2'AL'#4'left'#3#130#0#3'top'#3#200#0#0#7'TA' - +'ction'#5'actOK'#7'Caption'#6#2'OK'#18'DisableIfNoHandler'#9#9'OnExecute'#7 - +#12'actOKExecute'#8'OnUpdate'#7#11'actOKUpdate'#0#0#7'TAction'#12'actNewMeth' - +'od'#7'Caption'#6#13'New operation'#18'DisableIfNoHandler'#9#9'OnExecute'#7 - +#19'actNewMethodExecute'#0#0#7'TAction'#18'actUpdateOperation'#7'Caption'#6 - +#14'Edit Operation'#18'DisableIfNoHandler'#9#9'OnExecute'#7#25'actUpdateOper' - +'ationExecute'#8'OnUpdate'#7#24'actUpdateOperationUpdate'#0#0#7'TAction'#18 - +'actDeleteOperation'#7'Caption'#6#16'Delete Operation'#18'DisableIfNoHandler' - +#9#9'OnExecute'#7#25'actDeleteOperationExecute'#8'OnUpdate'#7#24'actUpdateOp' - +'erationUpdate'#0#0#7'TAction'#14'actBindingEdit'#7'Caption'#6#12'Edit Bindi' - +'ng'#18'DisableIfNoHandler'#9#9'OnExecute'#7#21'actBindingEditExecute'#8'OnU' - +'pdate'#7#20'actBindingEditUpdate'#0#0#0#10'TPopupMenu'#10'PopupMenu1'#4'lef' - +'t'#2'T'#3'top'#3#233#0#0#9'TMenuItem'#9'MenuItem1'#6'Action'#7#12'actNewMet' - +'hod'#7'OnClick'#7#19'actNewMethodExecute'#0#0#9'TMenuItem'#9'MenuItem2'#6'A' - +'ction'#7#18'actUpdateOperation'#7'OnClick'#7#25'actUpdateOperationExecute'#0 - +#0#9'TMenuItem'#9'MenuItem3'#6'Action'#7#18'actDeleteOperation'#7'OnClick'#7 - +#25'actDeleteOperationExecute'#0#0#9'TMenuItem'#9'MenuItem4'#7'Caption'#6#1 - +'-'#0#0#9'TMenuItem'#9'MenuItem5'#6'Action'#7#14'actBindingEdit'#7'OnClick'#7 - +#21'actBindingEditExecute'#0#0#0#0 + +'th'#3#19#2#8'OnCreate'#7#10'FormCreate'#8'Position'#7#15'poDesktopCenter'#10 + +'LCLVersion'#6#6'0.9.25'#0#6'TPanel'#6'Panel1'#6'Height'#2'2'#3'Top'#3#2#2#5 + +'Width'#3#19#2#5'Align'#7#8'alBottom'#12'ClientHeight'#2'2'#11'ClientWidth'#3 + +#19#2#8'TabOrder'#2#0#0#7'TButton'#7'Button1'#4'Left'#3#180#1#6'Height'#2#25 + +#3'Top'#2#10#5'Width'#2'K'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpac' + +'ing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2 + +#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Left'#3'Z'#1#6'Height'#2#25#3'T' + +'op'#2#10#5'Width'#2'K'#6'Action'#7#5'actOK'#7'Anchors'#11#5'akTop'#7'akRigh' + +'t'#0#25'BorderSpacing.InnerBorder'#2#4#7'Default'#9#8'TabOrder'#2#1#0#0#0#12 + +'TPageControl'#2'PC'#6'Height'#3#2#2#5'Width'#3#19#2#10'ActivePage'#7#9'TabS' + +'heet1'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTabSheet' + +#9'TabSheet1'#7'Caption'#6#20'Interface definition'#12'ClientHeight'#3#232#1 + +#11'ClientWidth'#3#11#2#0#6'TLabel'#6'Label1'#4'Left'#2#20#6'Height'#2#14#3 + +'Top'#2#26#5'Width'#2#28#7'Caption'#6#4'Name'#11'ParentColor'#8#0#0#5'TEdit' + +#7'edtName'#4'Left'#2'<'#6'Height'#2#23#3'Top'#2#26#5'Width'#3#187#1#7'Ancho' + +'rs'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#0#0#0#9'TGroupBox'#9'G' + +'roupBox1'#4'Left'#2#20#6'Height'#3'p'#1#3'Top'#2'J'#5'Width'#3#228#1#7'Anch' + +'ors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#7'Caption'#6#11' Metho' + +'ds '#12'ClientHeight'#3'^'#1#11'ClientWidth'#3#224#1#8'TabOrder'#2#1#0#9'T' + +'TreeView'#10'trvMethods'#6'Height'#3'^'#1#5'Width'#3#224#1#5'Align'#7#8'alC' + +'lient'#17'DefaultItemHeight'#2#15#9'PopupMenu'#7#10'PopupMenu1'#8'TabOrder' + +#2#0#0#0#0#7'TButton'#7'Button3'#4'Left'#2#20#6'Height'#2#25#3'Top'#3#194#1#5 + +'Width'#2'c'#6'Action'#7#12'actNewMethod'#25'BorderSpacing.InnerBorder'#2#4#8 + +'TabOrder'#2#2#0#0#7'TButton'#7'Button4'#4'Left'#3#132#0#6'Height'#2#25#3'To' + +'p'#3#194#1#5'Width'#2'k'#6'Action'#7#18'actUpdateOperation'#25'BorderSpacin' + +'g.InnerBorder'#2#4#8'TabOrder'#2#3#0#0#7'TButton'#7'Button5'#4'Left'#3#252#0 + +#6'Height'#2#25#3'Top'#3#194#1#5'Width'#2'h'#6'Action'#7#18'actDeleteOperati' + +'on'#25'BorderSpacing.InnerBorder'#2#4#8'TabOrder'#2#4#0#0#7'TButton'#7'Butt' + +'on6'#4'Left'#3#140#1#6'Height'#2#25#3'Top'#3#194#1#5'Width'#2'k'#6'Action'#7 + +#14'actBindingEdit'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.Inn' + +'erBorder'#2#4#8'TabOrder'#2#5#0#0#0#0#11'TActionList'#2'AL'#4'left'#3#130#0 + +#3'top'#3#200#0#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18'DisableIfNoHandl' + +'er'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actOKUpdate'#0#0#7'T' + +'Action'#12'actNewMethod'#7'Caption'#6#13'New operation'#18'DisableIfNoHandl' + +'er'#9#9'OnExecute'#7#19'actNewMethodExecute'#0#0#7'TAction'#18'actUpdateOpe' + +'ration'#7'Caption'#6#14'Edit Operation'#18'DisableIfNoHandler'#9#9'OnExecut' + +'e'#7#25'actUpdateOperationExecute'#8'OnUpdate'#7#24'actUpdateOperationUpdat' + +'e'#0#0#7'TAction'#18'actDeleteOperation'#7'Caption'#6#16'Delete Operation' + +#18'DisableIfNoHandler'#9#9'OnExecute'#7#25'actDeleteOperationExecute'#8'OnU' + +'pdate'#7#24'actUpdateOperationUpdate'#0#0#7'TAction'#14'actBindingEdit'#7'C' + +'aption'#6#12'Edit Binding'#18'DisableIfNoHandler'#9#9'OnExecute'#7#21'actBi' + +'ndingEditExecute'#8'OnUpdate'#7#20'actBindingEditUpdate'#0#0#0#10'TPopupMen' + +'u'#10'PopupMenu1'#4'left'#2'T'#3'top'#3#233#0#0#9'TMenuItem'#9'MenuItem1'#6 + +'Action'#7#12'actNewMethod'#7'OnClick'#7#19'actNewMethodExecute'#0#0#9'TMenu' + +'Item'#9'MenuItem2'#6'Action'#7#18'actUpdateOperation'#7'OnClick'#7#25'actUp' + +'dateOperationExecute'#0#0#9'TMenuItem'#9'MenuItem3'#6'Action'#7#18'actDelet' + +'eOperation'#7'OnClick'#7#25'actDeleteOperationExecute'#0#0#9'TMenuItem'#9'M' + +'enuItem4'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#9'MenuItem5'#6'Action'#7#14'ac' + +'tBindingEdit'#7'OnClick'#7#21'actBindingEditExecute'#0#0#0#0 ]); diff --git a/wst/trunk/type_lib_edtr/umoduleedit.lfm b/wst/trunk/type_lib_edtr/umoduleedit.lfm index 25dceeb78..f0d434500 100644 --- a/wst/trunk/type_lib_edtr/umoduleedit.lfm +++ b/wst/trunk/type_lib_edtr/umoduleedit.lfm @@ -1,19 +1,24 @@ object fModuleEdit: TfModuleEdit Left = 750 Height = 300 - Top = 92 + Top = 93 Width = 400 HorzScrollBar.Page = 399 VertScrollBar.Page = 299 ActiveControl = Button1 BorderStyle = bsSizeToolWin - Caption = 'fModuleEdit' + Caption = 'Module properties' + ClientHeight = 300 + ClientWidth = 400 Position = poMainFormCenter + LCLVersion = '0.9.25' object Panel1: TPanel Height = 50 Top = 250 Width = 400 Align = alBottom + ClientHeight = 50 + ClientWidth = 400 TabOrder = 0 object Button1: TButton Left = 224 @@ -46,13 +51,14 @@ object fModuleEdit: TfModuleEdit TabOrder = 1 object TabSheet1: TTabSheet Caption = 'Module' + ClientHeight = 224 + ClientWidth = 392 object Label1: TLabel Left = 20 Height = 14 Top = 39 Width = 28 Caption = 'Name' - Color = clNone ParentColor = False end object Label2: TLabel @@ -61,14 +67,13 @@ object fModuleEdit: TfModuleEdit Top = 127 Width = 56 Caption = 'Namespace' - Color = clNone ParentColor = False end object edtName: TEdit Left = 20 Height = 23 Top = 55 - Width = 352 + Width = 344 Anchors = [akTop, akLeft, akRight] TabOrder = 0 Text = 'edtName' @@ -77,7 +82,7 @@ object fModuleEdit: TfModuleEdit Left = 20 Height = 23 Top = 143 - Width = 352 + Width = 344 Anchors = [akTop, akLeft, akRight] TabOrder = 1 Text = 'edtNamespace' diff --git a/wst/trunk/type_lib_edtr/umoduleedit.lrs b/wst/trunk/type_lib_edtr/umoduleedit.lrs index b8a7d22a8..65ab9c0aa 100644 --- a/wst/trunk/type_lib_edtr/umoduleedit.lrs +++ b/wst/trunk/type_lib_edtr/umoduleedit.lrs @@ -2,27 +2,29 @@ LazarusResources.Add('TfModuleEdit','FORMDATA',[ 'TPF0'#12'TfModuleEdit'#11'fModuleEdit'#4'Left'#3#238#2#6'Height'#3','#1#3'To' - +'p'#2'\'#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Pa' + +'p'#2']'#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Pa' +'ge'#3'+'#1#13'ActiveControl'#7#7'Button1'#11'BorderStyle'#7#13'bsSizeToolWi' - +'n'#7'Caption'#6#11'fModuleEdit'#8'Position'#7#16'poMainFormCenter'#0#6'TPan' - +'el'#6'Panel1'#6'Height'#2'2'#3'Top'#3#250#0#5'Width'#3#144#1#5'Align'#7#8'a' - +'lBottom'#8'TabOrder'#2#0#0#7'TButton'#7'Button1'#4'Left'#3#224#0#6'Height'#2 - +#25#3'Top'#2#14#5'Width'#2'K'#6'Action'#7#5'actOK'#25'BorderSpacing.InnerBor' - +'der'#2#4#7'Default'#9#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Left'#3'8' - +#1#6'Height'#2#25#3'Top'#2#14#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#4 - +#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#1#0#0#0 - +#12'TPageControl'#12'PageControl1'#6'Height'#3#250#0#5'Width'#3#144#1#10'Act' - +'ivePage'#7#9'TabSheet1'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2 - +#1#0#9'TTabSheet'#9'TabSheet1'#7'Caption'#6#6'Module'#0#6'TLabel'#6'Label1'#4 - +'Left'#2#20#6'Height'#2#14#3'Top'#2''''#5'Width'#2#28#7'Caption'#6#4'Name'#5 - +'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#20#6 - +'Height'#2#14#3'Top'#2''#5'Width'#2'8'#7'Caption'#6#9'Namespace'#5'Color'#7 - +#6'clNone'#11'ParentColor'#8#0#0#5'TEdit'#7'edtName'#4'Left'#2#20#6'Height'#2 - +#23#3'Top'#2'7'#5'Width'#3'`'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0 - +#8'TabOrder'#2#0#4'Text'#6#7'edtName'#0#0#5'TEdit'#12'edtNamespace'#4'Left'#2 - +#20#6'Height'#2#23#3'Top'#3#143#0#5'Width'#3'`'#1#7'Anchors'#11#5'akTop'#6'a' - +'kLeft'#7'akRight'#0#8'TabOrder'#2#1#4'Text'#6#12'edtNamespace'#0#0#0#0#11'T' - +'ActionList'#2'AL'#4'left'#2's'#3'top'#2'~'#0#7'TAction'#5'actOK'#7'Caption' - +#6#2'OK'#18'DisableIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate' - +#7#11'actOKUpdate'#0#0#0#0 + +'n'#7'Caption'#6#17'Module properties'#12'ClientHeight'#3','#1#11'ClientWidt' + +'h'#3#144#1#8'Position'#7#16'poMainFormCenter'#10'LCLVersion'#6#6'0.9.25'#0#6 + +'TPanel'#6'Panel1'#6'Height'#2'2'#3'Top'#3#250#0#5'Width'#3#144#1#5'Align'#7 + +#8'alBottom'#12'ClientHeight'#2'2'#11'ClientWidth'#3#144#1#8'TabOrder'#2#0#0 + +#7'TButton'#7'Button1'#4'Left'#3#224#0#6'Height'#2#25#3'Top'#2#14#5'Width'#2 + +'K'#6'Action'#7#5'actOK'#25'BorderSpacing.InnerBorder'#2#4#7'Default'#9#8'Ta' + +'bOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Left'#3'8'#1#6'Height'#2#25#3'Top'#2 + +#14#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6 + +#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#1#0#0#0#12'TPageControl'#12'Pag' + +'eControl1'#6'Height'#3#250#0#5'Width'#3#144#1#10'ActivePage'#7#9'TabSheet1' + +#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTabSheet'#9'Tab' + +'Sheet1'#7'Caption'#6#6'Module'#12'ClientHeight'#3#224#0#11'ClientWidth'#3 + +#136#1#0#6'TLabel'#6'Label1'#4'Left'#2#20#6'Height'#2#14#3'Top'#2''''#5'Widt' + +'h'#2#28#7'Caption'#6#4'Name'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Le' + +'ft'#2#20#6'Height'#2#14#3'Top'#2''#5'Width'#2'8'#7'Caption'#6#9'Namespace' + +#11'ParentColor'#8#0#0#5'TEdit'#7'edtName'#4'Left'#2#20#6'Height'#2#23#3'Top' + +#2'7'#5'Width'#3'X'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrd' + +'er'#2#0#4'Text'#6#7'edtName'#0#0#5'TEdit'#12'edtNamespace'#4'Left'#2#20#6'H' + +'eight'#2#23#3'Top'#3#143#0#5'Width'#3'X'#1#7'Anchors'#11#5'akTop'#6'akLeft' + +#7'akRight'#0#8'TabOrder'#2#1#4'Text'#6#12'edtNamespace'#0#0#0#0#11'TActionL' + +'ist'#2'AL'#4'left'#2's'#3'top'#2'~'#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK' + +#18'DisableIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11'a' + +'ctOKUpdate'#0#0#0#0 ]); diff --git a/wst/trunk/ws_helper/generator.pas b/wst/trunk/ws_helper/generator.pas index da21b43ab..26257fc2d 100644 --- a/wst/trunk/ws_helper/generator.pas +++ b/wst/trunk/ws_helper/generator.pas @@ -153,6 +153,11 @@ type FImpTempStream : ISourceStream; FImpLastStream : ISourceStream; FRttiFunc : ISourceStream; + private + // Array handling helper routines + procedure WriteObjectArray(ASymbol : TPasArrayType); + procedure WriteSimpleTypeArray(ASymbol : TPasArrayType); + procedure WriteObjectCollection(ASymbol : TPasArrayType); private function GenerateIntfName(AIntf : TPasElement):string; @@ -1756,6 +1761,230 @@ end; { TInftGenerator } +procedure TInftGenerator.WriteObjectArray(ASymbol : TPasArrayType); +begin + SetCurrentStream(FDecStream); + NewLine(); + IncIndent(); + BeginAutoIndent(); + try + WriteLn('%s = class(TBaseObjectArrayRemotable)',[ASymbol.Name]); + WriteLn('private'); + Indent();WriteLn('function GetItem(AIndex: Integer): %s;',[ASymbol.ElType.Name]); + WriteLn('public'); + Indent();WriteLn('class function GetItemClass():TBaseRemotableClass;override;'); + Indent();WriteLn('property Item[AIndex:Integer] : %s Read GetItem;Default;',[ASymbol.ElType.Name]); + WriteLn('end;'); + finally + EndAutoIndent(); + DecIndent(); + end; + + SetCurrentStream(FImpStream); + NewLine(); + WriteLn('{ %s }',[ASymbol.Name]); + + NewLine(); + WriteLn('function %s.GetItem(AIndex: Integer): %s;',[ASymbol.Name,ASymbol.ElType.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('Result := %s(Inherited GetItem(AIndex));',[ASymbol.ElType.Name]); + DecIndent(); + WriteLn('end;'); + + NewLine(); + WriteLn('class function %s.GetItemClass(): TBaseRemotableClass;',[ASymbol.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('Result:= %s;',[ASymbol.ElType.Name]); + DecIndent(); + WriteLn('end;'); +end; + +procedure TInftGenerator.WriteSimpleTypeArray(ASymbol : TPasArrayType); +begin + SetCurrentStream(FDecStream); + NewLine(); + IncIndent(); + BeginAutoIndent(); + try + WriteLn('%s = class(TBaseSimpleTypeArrayRemotable)',[ASymbol.Name]); + WriteLn('private'); + Indent();WriteLn('FData : array of %s;',[ASymbol.ElType.Name]); + WriteLn('private'); + Indent();WriteLn('function GetItem(AIndex: Integer): %s;',[ASymbol.ElType.Name]); + Indent();WriteLn('procedure SetItem(AIndex: Integer; const AValue: %s);',[ASymbol.ElType.Name]); + WriteLn('protected'); + Indent();WriteLn('function GetLength():Integer;override;'); + Indent();WriteLn('procedure SaveItem(AStore : IFormatterBase;const AName : String;const AIndex : Integer);override;'); + Indent();WriteLn('procedure LoadItem(AStore : IFormatterBase;const AIndex : Integer);override;'); + WriteLn('public'); + Indent();WriteLn('class function GetItemTypeInfo():PTypeInfo;override;'); + Indent();WriteLn('procedure SetLength(const ANewSize : Integer);override;'); + Indent();WriteLn('procedure Assign(Source: TPersistent); override;'); + Indent();WriteLn('property Item[AIndex:Integer] : %s read GetItem write SetItem; default;',[ASymbol.ElType.Name]); + WriteLn('end;'); + finally + EndAutoIndent(); + DecIndent(); + end; + + SetCurrentStream(FImpStream); + NewLine(); + WriteLn('{ %s }',[ASymbol.Name]); + + NewLine(); + WriteLn('function %s.GetItem(AIndex: Integer): %s;',[ASymbol.Name,ASymbol.ElType.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('CheckIndex(AIndex);'); + Indent();WriteLn('Result := FData[AIndex];'); + DecIndent(); + WriteLn('end;'); + + NewLine(); + WriteLn('procedure %s.SetItem(AIndex: Integer;const AValue: %S);',[ASymbol.Name,ASymbol.ElType.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('CheckIndex(AIndex);'); + Indent();WriteLn('FData[AIndex] := AValue;'); + DecIndent(); + WriteLn('end;'); + + NewLine(); + WriteLn('function %s.GetLength(): Integer;',[ASymbol.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('Result := System.Length(FData);'); + DecIndent(); + WriteLn('end;'); + + NewLine(); + WriteLn('procedure %s.SaveItem(AStore: IFormatterBase;const AName: String; const AIndex: Integer);',[ASymbol.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('AStore.Put(%s,TypeInfo(%s),FData[AIndex]);',[QuotedStr(SymbolTable.GetArrayItemName(ASymbol)),ASymbol.ElType.Name]); + DecIndent(); + WriteLn('end;'); + + NewLine(); + IncIndent(); + WriteLn('procedure %s.LoadItem(AStore: IFormatterBase;const AIndex: Integer);',[ASymbol.Name]); + WriteLn('var'); + Indent();WriteLn('sName : string;'); + WriteLn('begin'); + Indent();WriteLn('sName := %s;',[QuotedStr(SymbolTable.GetArrayItemName(ASymbol))]); + Indent();WriteLn('AStore.Get(TypeInfo(%s),sName,FData[AIndex]);',[ASymbol.ElType.Name]); + DecIndent(); + WriteLn('end;'); + + NewLine(); + WriteLn('class function %s.GetItemTypeInfo(): PTypeInfo;',[ASymbol.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('Result := TypeInfo(%s);',[ASymbol.ElType.Name]); + DecIndent(); + WriteLn('end;'); + + NewLine(); + IncIndent(); + WriteLn('procedure %s.SetLength(const ANewSize: Integer);',[ASymbol.Name]); + WriteLn('var'); + Indent();WriteLn('i : Integer;'); + WriteLn('begin'); + Indent();WriteLn('if ( ANewSize < 0 ) then'); + Indent();Indent();WriteLn('i := 0'); + Indent();WriteLn('else'); + Indent();Indent();WriteLn('i := ANewSize;'); + Indent();WriteLn('System.SetLength(FData,i);'); + DecIndent(); + WriteLn('end;'); + + NewLine(); + IncIndent(); + WriteLn('procedure %s.Assign(Source: TPersistent);',[ASymbol.Name]); + WriteLn('var'); + Indent();WriteLn('src : %s;',[ASymbol.Name]); + Indent();WriteLn('i, c : PtrInt;'); + WriteLn('begin'); + Indent();WriteLn('if Assigned(Source) and Source.InheritsFrom(%s) then begin',[ASymbol.Name]); + IncIndent(); + Indent();WriteLn('src := %s(Source);',[ASymbol.Name]); + Indent();WriteLn('c := src.Length;'); + Indent();WriteLn('Self.SetLength(c);'); + Indent();WriteLn('if ( c > 0 ) then begin'); + IncIndent(); + Indent();WriteLn('for i := 0 to Pred(c) do begin'); + IncIndent(); Indent(); WriteLn('Self[i] := src[i];'); DecIndent(); + Indent();WriteLn('end;'); + DecIndent(); + Indent();WriteLn('end;'); + DecIndent(); + Indent();WriteLn('end else begin'); + IncIndent(); Indent(); WriteLn('inherited Assign(Source);'); DecIndent(); + Indent();WriteLn('end;'); + DecIndent(); + WriteLn('end;'); +end; + +procedure TInftGenerator.WriteObjectCollection(ASymbol : TPasArrayType); +begin + SetCurrentStream(FDecStream); + NewLine(); + IncIndent(); + BeginAutoIndent(); + try + WriteLn('%s = class(TObjectCollectionRemotable)',[ASymbol.Name]); + WriteLn('private'); + Indent();WriteLn('function GetItem(AIndex: Integer): %s;',[ASymbol.ElType.Name]); + WriteLn('public'); + Indent();WriteLn('class function GetItemClass():TBaseRemotableClass;override;'); + Indent();WriteLn('function Add(): %s; {$IFDEF USE_INLINE}inline;{$ENDIF}',[ASymbol.ElType.Name]); + Indent();WriteLn('function AddAt(const APosition : Integer) : %s; {$IFDEF USE_INLINE}inline;{$ENDIF}',[ASymbol.ElType.Name]); + Indent();WriteLn('property Item[AIndex:Integer] : %s Read GetItem;Default;',[ASymbol.ElType.Name]); + WriteLn('end;'); + finally + EndAutoIndent(); + DecIndent(); + end; + + SetCurrentStream(FImpStream); + NewLine(); + WriteLn('{ %s }',[ASymbol.Name]); + + NewLine(); + WriteLn('function %s.GetItem(AIndex: Integer): %s;',[ASymbol.Name,ASymbol.ElType.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('Result := %s(Inherited GetItem(AIndex));',[ASymbol.ElType.Name]); + DecIndent(); + WriteLn('end;'); + + NewLine(); + WriteLn('class function %s.GetItemClass(): TBaseRemotableClass;',[ASymbol.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('Result:= %s;',[ASymbol.ElType.Name]); + DecIndent(); + WriteLn('end;'); + + NewLine(); + WriteLn('function %s.Add() : %s;',[ASymbol.Name,ASymbol.ElType.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('Result := %s(inherited Add());',[ASymbol.ElType.Name]); + DecIndent(); + WriteLn('end;'); + + NewLine(); + WriteLn('function %s.AddAt(const APosition : Integer) : %s;',[ASymbol.Name,ASymbol.ElType.Name]); + WriteLn('begin'); + IncIndent(); + Indent();WriteLn('Result := %s(inherited AddAt(APosition));',[ASymbol.ElType.Name]); + DecIndent(); + WriteLn('end;'); +end; + function TInftGenerator.GenerateIntfName(AIntf: TPasElement): string; begin Result := ExtractserviceName(AIntf); @@ -2240,173 +2469,6 @@ begin end; procedure TInftGenerator.GenerateArray(ASymbol: TPasArrayType); - - procedure WriteObjectArray(); - begin - SetCurrentStream(FDecStream); - NewLine(); - IncIndent(); - BeginAutoIndent(); - try - WriteLn('%s = class(TBaseObjectArrayRemotable)',[ASymbol.Name]); - WriteLn('private'); - Indent();WriteLn('function GetItem(AIndex: Integer): %s;',[ASymbol.ElType.Name]); - WriteLn('public'); - Indent();WriteLn('class function GetItemClass():TBaseRemotableClass;override;'); - Indent();WriteLn('property Item[AIndex:Integer] : %s Read GetItem;Default;',[ASymbol.ElType.Name]); - WriteLn('end;'); - finally - EndAutoIndent(); - DecIndent(); - end; - - SetCurrentStream(FImpStream); - NewLine(); - WriteLn('{ %s }',[ASymbol.Name]); - - NewLine(); - WriteLn('function %s.GetItem(AIndex: Integer): %s;',[ASymbol.Name,ASymbol.ElType.Name]); - WriteLn('begin'); - IncIndent(); - Indent();WriteLn('Result := Inherited GetItem(AIndex) As %s;',[ASymbol.ElType.Name]); - DecIndent(); - WriteLn('end;'); - - NewLine(); - WriteLn('class function %s.GetItemClass(): TBaseRemotableClass;',[ASymbol.Name]); - WriteLn('begin'); - IncIndent(); - Indent();WriteLn('Result:= %s;',[ASymbol.ElType.Name]); - DecIndent(); - WriteLn('end;'); - end; - - procedure WriteSimpleTypeArray(); - begin - SetCurrentStream(FDecStream); - NewLine(); - IncIndent(); - BeginAutoIndent(); - try - WriteLn('%s = class(TBaseSimpleTypeArrayRemotable)',[ASymbol.Name]); - WriteLn('private'); - Indent();WriteLn('FData : array of %s;',[ASymbol.ElType.Name]); - WriteLn('private'); - Indent();WriteLn('function GetItem(AIndex: Integer): %s;',[ASymbol.ElType.Name]); - Indent();WriteLn('procedure SetItem(AIndex: Integer; const AValue: %s);',[ASymbol.ElType.Name]); - WriteLn('protected'); - Indent();WriteLn('function GetLength():Integer;override;'); - Indent();WriteLn('procedure SaveItem(AStore : IFormatterBase;const AName : String;const AIndex : Integer);override;'); - Indent();WriteLn('procedure LoadItem(AStore : IFormatterBase;const AIndex : Integer);override;'); - WriteLn('public'); - Indent();WriteLn('class function GetItemTypeInfo():PTypeInfo;override;'); - Indent();WriteLn('procedure SetLength(const ANewSize : Integer);override;'); - Indent();WriteLn('procedure Assign(Source: TPersistent); override;'); - Indent();WriteLn('property Item[AIndex:Integer] : %s read GetItem write SetItem; default;',[ASymbol.ElType.Name]); - WriteLn('end;'); - finally - EndAutoIndent(); - DecIndent(); - end; - - SetCurrentStream(FImpStream); - NewLine(); - WriteLn('{ %s }',[ASymbol.Name]); - - NewLine(); - WriteLn('function %s.GetItem(AIndex: Integer): %s;',[ASymbol.Name,ASymbol.ElType.Name]); - WriteLn('begin'); - IncIndent(); - Indent();WriteLn('CheckIndex(AIndex);'); - Indent();WriteLn('Result := FData[AIndex];'); - DecIndent(); - WriteLn('end;'); - - NewLine(); - WriteLn('procedure %s.SetItem(AIndex: Integer;const AValue: %S);',[ASymbol.Name,ASymbol.ElType.Name]); - WriteLn('begin'); - IncIndent(); - Indent();WriteLn('CheckIndex(AIndex);'); - Indent();WriteLn('FData[AIndex] := AValue;'); - DecIndent(); - WriteLn('end;'); - - NewLine(); - WriteLn('function %s.GetLength(): Integer;',[ASymbol.Name]); - WriteLn('begin'); - IncIndent(); - Indent();WriteLn('Result := System.Length(FData);'); - DecIndent(); - WriteLn('end;'); - - NewLine(); - WriteLn('procedure %s.SaveItem(AStore: IFormatterBase;const AName: String; const AIndex: Integer);',[ASymbol.Name]); - WriteLn('begin'); - IncIndent(); - Indent();WriteLn('AStore.Put(%s,TypeInfo(%s),FData[AIndex]);',[QuotedStr(SymbolTable.GetArrayItemName(ASymbol)),ASymbol.ElType.Name]); - DecIndent(); - WriteLn('end;'); - - NewLine(); - IncIndent(); - WriteLn('procedure %s.LoadItem(AStore: IFormatterBase;const AIndex: Integer);',[ASymbol.Name]); - WriteLn('var'); - Indent();WriteLn('sName : string;'); - WriteLn('begin'); - Indent();WriteLn('sName := %s;',[QuotedStr(SymbolTable.GetArrayItemName(ASymbol))]); - Indent();WriteLn('AStore.Get(TypeInfo(%s),sName,FData[AIndex]);',[ASymbol.ElType.Name]); - DecIndent(); - WriteLn('end;'); - - NewLine(); - WriteLn('class function %s.GetItemTypeInfo(): PTypeInfo;',[ASymbol.Name]); - WriteLn('begin'); - IncIndent(); - Indent();WriteLn('Result := TypeInfo(%s);',[ASymbol.ElType.Name]); - DecIndent(); - WriteLn('end;'); - - NewLine(); - IncIndent(); - WriteLn('procedure %s.SetLength(const ANewSize: Integer);',[ASymbol.Name]); - WriteLn('var'); - Indent();WriteLn('i : Integer;'); - WriteLn('begin'); - Indent();WriteLn('if ( ANewSize < 0 ) then'); - Indent();Indent();WriteLn('i := 0'); - Indent();WriteLn('else'); - Indent();Indent();WriteLn('i := ANewSize;'); - Indent();WriteLn('System.SetLength(FData,i);'); - DecIndent(); - WriteLn('end;'); - - NewLine(); - IncIndent(); - WriteLn('procedure %s.Assign(Source: TPersistent);',[ASymbol.Name]); - WriteLn('var'); - Indent();WriteLn('src : %s;',[ASymbol.Name]); - Indent();WriteLn('i, c : PtrInt;'); - WriteLn('begin'); - Indent();WriteLn('if Assigned(Source) and Source.InheritsFrom(%s) then begin',[ASymbol.Name]); - IncIndent(); - Indent();WriteLn('src := %s(Source);',[ASymbol.Name]); - Indent();WriteLn('c := src.Length;'); - Indent();WriteLn('Self.SetLength(c);'); - Indent();WriteLn('if ( c > 0 ) then begin'); - IncIndent(); - Indent();WriteLn('for i := 0 to Pred(c) do begin'); - IncIndent(); Indent(); WriteLn('Self[i] := src[i];'); DecIndent(); - Indent();WriteLn('end;'); - DecIndent(); - Indent();WriteLn('end;'); - DecIndent(); - Indent();WriteLn('end else begin'); - IncIndent(); Indent(); WriteLn('inherited Assign(Source);'); DecIndent(); - Indent();WriteLn('end;'); - DecIndent(); - WriteLn('end;'); - end; - var classItemArray : Boolean; eltType : TPasType; @@ -2418,9 +2480,12 @@ begin classItemArray := SymbolTable.IsOfType(eltType,TPasClassType) or SymbolTable.IsOfType(eltType,TPasArrayType); if classItemArray then begin - WriteObjectArray(); + if FSymbolTable.IsCollection(ASymbol) then + WriteObjectCollection(ASymbol) + else + WriteObjectArray(ASymbol); end else begin - WriteSimpleTypeArray(); + WriteSimpleTypeArray(ASymbol); end; FImpTempStream.Indent(); diff --git a/wst/trunk/ws_helper/parserutils.pas b/wst/trunk/ws_helper/parserutils.pas index 4f9f1a6c9..fca672daf 100644 --- a/wst/trunk/ws_helper/parserutils.pas +++ b/wst/trunk/ws_helper/parserutils.pas @@ -282,7 +282,7 @@ var begin Result := False; if Assigned(ANode) and ( ANode.Attributes <> nil ) then begin - nd := ANode.Attributes.GetNamedItem(AAttribute); + nd := ANode.Attributes.GetNamedItem(Format('%s:%s',[s_WST,AAttribute])); if Assigned(nd) then begin Result := True; AValue := nd.NodeValue; diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas index 4358bad99..da684e991 100644 --- a/wst/trunk/ws_helper/pascal_parser_intf.pas +++ b/wst/trunk/ws_helper/pascal_parser_intf.pas @@ -27,7 +27,8 @@ const sARRAY_STYLE = 'ARRAY_STYLE'; sARRAY_STYLE_SCOPED = 'ARRAY_STYLE_SCOPED'; sARRAY_STYLE_EMBEDDED = 'ARRAY_STYLE_EMBEDDED'; - + sARRAY_IS_COLLECTION = 'ARRAY_COLLECTION'; + sXSD_NS = 'http://www.w3.org/2001/XMLSchema'; type @@ -112,6 +113,8 @@ type function GetArrayStyle(AArray : TPasArrayType) : TArrayStyle; procedure SetArrayStyle(AArray : TPasArrayType; const AStyle : TArrayStyle); procedure SetArrayItemExternalName(AArray : TPasArrayType; const AExternalName : string); + function IsCollection(AArray : TPasArrayType) : Boolean; + procedure SetCollectionFlag(AArray : TPasArrayType; const AFlag : Boolean); function FindElement(const AName: String): TPasElement; override; function FindElementNS(const AName, ANameSpace : string): TPasElement; function FindElementInModule(const AName: String; AModule: TPasModule): TPasElement; @@ -605,6 +608,22 @@ begin Properties.SetValue(AArray,sARRAY_ITEM_EXT_NAME,AExternalName); end; +function TwstPasTreeContainer.IsCollection(AArray : TPasArrayType) : Boolean; +begin + Result := AnsiSameText('true',Properties.GetValue(AArray,sARRAY_IS_COLLECTION)); +end; + +procedure TwstPasTreeContainer.SetCollectionFlag( + AArray : TPasArrayType; + const AFlag : Boolean +); +begin + if AFlag then + Properties.SetValue(AArray,sARRAY_IS_COLLECTION,'true') + else + Properties.SetValue(AArray,sARRAY_IS_COLLECTION,'false'); +end; + function TwstPasTreeContainer.FindElementInModule(const AName: String; AModule : TPasModule): TPasElement; var decs : TList; diff --git a/wst/trunk/ws_helper/ws_helper.lpi b/wst/trunk/ws_helper/ws_helper.lpi index 468a69b97..d018b4216 100644 --- a/wst/trunk/ws_helper/ws_helper.lpi +++ b/wst/trunk/ws_helper/ws_helper.lpi @@ -148,8 +148,10 @@ - + + + nil ) and ( GetNodeListCount(ANode.Attributes) > 0 ) then begin + ls := ANode.Attributes; + q := GetNodeListCount(ANode.Attributes); + for k := 0 to ( q - 1 ) do begin + e := ls.Item[k]; + if ( Pos(':', e.NodeName) > 1 ) then begin + ExplodeQName(e.NodeName,localName,ns_short); + if FContext.FindNameSpace(ns_short, ns_long) then begin + locBuffer := e.NodeValue; + ExplodeQName(locBuffer,locBufferLocalName,locBufferNS); + if IsStrEmpty(locBufferNS) then + locBuffer := locBufferLocalName + else if FContext.FindNameSpace(locBufferNS, locBufferNS_long) then + locBuffer := Format('%s#%s',[locBufferNS_long,locBufferLocalName]); + FSymbols.Properties.SetValue(AItem,Format('%s#%s',[ns_long,localName]),locBuffer); + end; + end; + end; + end; +end; + +procedure TComplexTypeParser.GenerateArrayTypes( + const AClassName : string; + AArrayPropList : TPropInfoReferenceList +); +var + propRef : TPropInfoReference; + locPropTyp : TPasProperty; + k : Integer; + locString : string; + locSym : TPasElement; +begin + for k := 0 to Pred(AArrayPropList.GetCount()) do begin + propRef := AArrayPropList.GetItem(k); + locPropTyp := propRef.Prop; + locString := Format('%s_%sArray',[AClassName,locPropTyp.Name]); + locSym := FSymbols.FindElement(locString); + if ( locSym = nil ) then begin + locSym := FSymbols.CreateArray( + locString, + locPropTyp.VarType, + locPropTyp.Name, + FSymbols.GetExternalName(locPropTyp), + asEmbeded + ); + Self.Module.InterfaceSection.Declarations.Add(locSym); + Self.Module.InterfaceSection.Types.Add(locSym); + if propRef.IsCollection then + FSymbols.SetCollectionFlag(TPasArrayType(locSym),True); + end; + end; +end; + +function TComplexTypeParser.ExtractSoapArray( + const ATypeName : string; + const AInternalName : string; + const AHasInternalName : Boolean +) : TPasArrayType; +var + ls : TStringList; + crs, locCrs : IObjectCursor; + s : string; + i : Integer; + locSym : TPasElement; + ok : Boolean; + nd : TDOMNode; +begin + if not FDerivationNode.HasChildNodes then begin + raise EXsdInvalidTypeDefinitionException.CreateFmt('Invalid type definition, attributes not found : "%s".',[FTypeName]); + end; + crs := CreateCursorOn( + CreateChildrenCursor(FDerivationNode,cetRttiNode), + ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer) + ); + ls := TStringList.Create(); + try + ok := False; + crs.Reset(); + while crs.MoveNext() do begin + nd := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; + if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin + ls.Clear(); + ExtractNameSpaceShortNamesNested(nd,ls,s_wsdl); + locCrs := CreateAttributesCursor(nd,cetRttiNode); + locCrs := CreateCursorOn( + locCrs, + ParseFilter(CreateQualifiedNameFilterStr(s_arrayType,ls),TDOMNodeRttiExposer) + ); + if Assigned(locCrs) then begin + locCrs.Reset(); + if locCrs.MoveNext() then begin + ok := True; + Break; + end; + end; + end; + end; + finally + FreeAndNil(ls); + end; + if not ok then begin + raise EXsdInvalidTypeDefinitionException.CreateFmt('Invalid type definition, unable to find the "%s" attribute : "%s".',[s_arrayType,FTypeName]); + end; + s := ExtractNameFromQName((locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject.NodeValue); + i := Pos('[',s); + if ( i < 1 ) then begin + i := MaxInt; + end; + s := Copy(s,1,Pred(i)); + locSym := FSymbols.FindElement(s); + if not Assigned(locSym) then begin + locSym := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,s,Self.Module.InterfaceSection,visDefault,'',0)); + Self.Module.InterfaceSection.Declarations.Add(locSym); + Self.Module.InterfaceSection.Types.Add(locSym); + end; + if not locSym.InheritsFrom(TPasType) then + raise EXsdInvalidTypeDefinitionException.CreateFmt('Invalid array type definition, invalid item type definition : "%s".',[FTypeName]); + Result := FSymbols.CreateArray(AInternalName,locSym as TPasType,s_item,s_item,asScoped); + if AHasInternalName then + FSymbols.RegisterExternalAlias(Result,ATypeName); +end; + procedure TComplexTypeParser.CreateNodeCursors(); begin FAttCursor := CreateAttributesCursor(FTypeNode,cetRttiNode); @@ -402,96 +628,18 @@ begin end; function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TPasType; - - function ExtractElementCursor(out AAttCursor : IObjectCursor):IObjectCursor; - var - frstCrsr, tmpCursor : IObjectCursor; - parentNode, tmpNode : TDOMNode; - begin - Result := nil; - AAttCursor := nil; - case FDerivationMode of - dmNone : parentNode := FContentNode; - dmRestriction, - dmExtension : parentNode := FDerivationNode; - end; - if parentNode.HasChildNodes() then begin; - AAttCursor := CreateCursorOn( - CreateChildrenCursor(parentNode,cetRttiNode), - ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer) - ); - frstCrsr := CreateChildrenCursor(parentNode,cetRttiNode); - tmpCursor := CreateCursorOn( - frstCrsr.Clone() as IObjectCursor, - ParseFilter(CreateQualifiedNameFilterStr(s_sequence,FContext.GetXsShortNames()),TDOMNodeRttiExposer) - ); - tmpCursor.Reset(); - if tmpCursor.MoveNext() then begin - FSequenceType := stElement; - tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject; - if tmpNode.HasChildNodes() then begin - tmpCursor := CreateCursorOn( - CreateChildrenCursor(tmpNode,cetRttiNode), - ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer) - ); - Result := tmpCursor; - end; - end else begin - tmpCursor := CreateCursorOn( - frstCrsr.Clone() as IObjectCursor, - ParseFilter(CreateQualifiedNameFilterStr(s_all,FContext.GetXsShortNames()),TDOMNodeRttiExposer) - ); - tmpCursor.Reset(); - if tmpCursor.MoveNext() then begin - FSequenceType := stElement; - tmpNode := (tmpCursor.GetCurrent() as TDOMNodeRttiExposer).InnerObject; - if tmpNode.HasChildNodes() then begin - tmpCursor := CreateCursorOn( - CreateChildrenCursor(tmpNode,cetRttiNode), - ParseFilter(CreateQualifiedNameFilterStr(s_element,FContext.GetXsShortNames()),TDOMNodeRttiExposer) - ); - Result := tmpCursor; - end; - end; - end - end else begin - Result := nil; - end; - end; - var classDef : TPasClassType; isArrayDef : Boolean; - arrayItems : TObjectList; + arrayItems : TPropInfoReferenceList; - procedure ExtractExtendedMetadata(const AItem : TPasElement; const ANode : TDOMNode); + function IsCollectionArray(AElement : TDOMNode) : Boolean; var - ls : TDOMNamedNodeMap; - e : TDOMNode; - k, q : PtrInt; - ns_short, ns_long, localName, locBuffer, locBufferNS, locBufferNS_long, locBufferLocalName : string; + strBuffer : string; begin - if ( ANode.Attributes <> nil ) and ( GetNodeListCount(ANode.Attributes) > 0 ) then begin - ls := ANode.Attributes; - q := GetNodeListCount(ANode.Attributes); - for k := 0 to ( q - 1 ) do begin - e := ls.Item[k]; - if ( Pos(':', e.NodeName) > 1 ) then begin - ExplodeQName(e.NodeName,localName,ns_short); - if FContext.FindNameSpace(ns_short, ns_long) then begin - locBuffer := e.NodeValue; - ExplodeQName(locBuffer,locBufferLocalName,locBufferNS); - if IsStrEmpty(locBufferNS) then - locBuffer := locBufferLocalName - else if FContext.FindNameSpace(locBufferNS, locBufferNS_long) then - locBuffer := Format('%s#%s',[locBufferNS_long,locBufferLocalName]); - FSymbols.Properties.SetValue(AItem,Format('%s#%s',[ns_long,localName]),locBuffer); - end; - end; - end; - end; + Result := wst_findCustomAttributeXsd(FContext.GetXsShortNames(),AElement,s_WST_collection,strBuffer) and AnsiSameText('true',Trim(strBuffer)); end; - + procedure ParseElement(AElement : TDOMNode); var locAttCursor, locPartCursor : IObjectCursor; @@ -641,7 +789,7 @@ var end; isArrayDef := locMaxOccurUnbounded or ( locMaxOccur > 1 ); if isArrayDef then begin - arrayItems.Add(locProp); + arrayItems.Add(locProp).FIsCollection := IsCollectionArray(AElement); end; if AnsiSameText(s_attribute,ExtractNameFromQName(AElement.NodeName)) then begin FSymbols.SetPropertyAsAttribute(locProp,True); @@ -652,100 +800,7 @@ var locProp.DefaultValue := (locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue; ExtractExtendedMetadata(locProp,AElement); end; - - procedure GenerateArrayTypes( - const AClassName : string; - AArrayPropList : TObjectList - ); - var - locPropTyp : TPasProperty; - k : Integer; - locString : string; - locSym : TPasElement; - begin - for k := 0 to Pred(AArrayPropList.Count) do begin - locPropTyp := AArrayPropList[k] as TPasProperty; - locString := Format('%s_%sArray',[AClassName,locPropTyp.Name]); - locSym := FSymbols.FindElement(locString); - if ( locSym = nil ) then begin - locSym := FSymbols.CreateArray( - locString, - locPropTyp.VarType, - locPropTyp.Name, - FSymbols.GetExternalName(locPropTyp), - asEmbeded - ); - Self.Module.InterfaceSection.Declarations.Add(locSym); - Self.Module.InterfaceSection.Types.Add(locSym); - end; - end; - end; - - function ExtractSoapArray(const AInternalName : string; const AHasInternalName : Boolean) : TPasArrayType; - var - ls : TStringList; - crs, locCrs : IObjectCursor; - s : string; - i : Integer; - locSym : TPasElement; - ok : Boolean; - nd : TDOMNode; - begin - if not FDerivationNode.HasChildNodes then begin - raise EXsdInvalidTypeDefinitionException.CreateFmt('Invalid type definition, attributes not found : "%s".',[FTypeName]); - end; - crs := CreateCursorOn( - CreateChildrenCursor(FDerivationNode,cetRttiNode), - ParseFilter(CreateQualifiedNameFilterStr(s_attribute,FContext.GetXsShortNames()),TDOMNodeRttiExposer) - ); - ls := TStringList.Create(); - try - ok := False; - crs.Reset(); - while crs.MoveNext() do begin - nd := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; - if Assigned(nd.Attributes) and ( nd.Attributes.Length > 0 ) then begin - ls.Clear(); - ExtractNameSpaceShortNamesNested(nd,ls,s_wsdl); - locCrs := CreateAttributesCursor(nd,cetRttiNode); - locCrs := CreateCursorOn( - locCrs, - ParseFilter(CreateQualifiedNameFilterStr(s_arrayType,ls),TDOMNodeRttiExposer) - ); - if Assigned(locCrs) then begin - locCrs.Reset(); - if locCrs.MoveNext() then begin - ok := True; - Break; - end; - end; - end; - end; - finally - FreeAndNil(ls); - end; - if not ok then begin - raise EXsdInvalidTypeDefinitionException.CreateFmt('Invalid type definition, unable to find the "%s" attribute : "%s".',[s_arrayType,FTypeName]); - end; - s := ExtractNameFromQName((locCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject.NodeValue); - i := Pos('[',s); - if ( i < 1 ) then begin - i := MaxInt; - end; - s := Copy(s,1,Pred(i)); - locSym := FSymbols.FindElement(s); - if not Assigned(locSym) then begin - locSym := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,s,Self.Module.InterfaceSection,visDefault,'',0)); - Self.Module.InterfaceSection.Declarations.Add(locSym); - Self.Module.InterfaceSection.Types.Add(locSym); - end; - if not locSym.InheritsFrom(TPasType) then - raise EXsdInvalidTypeDefinitionException.CreateFmt('Invalid array type definition, invalid item type definition : "%s".',[FTypeName]); - Result := FSymbols.CreateArray(AInternalName,locSym as TPasType,s_item,s_item,asScoped); - if AHasInternalName then - FSymbols.RegisterExternalAlias(Result,ATypeName); - end; - + function IsHeaderBlock() : Boolean; var strBuffer : string; @@ -801,9 +856,9 @@ begin end; if ( FDerivationMode = dmRestriction ) and FSymbols.SameName(FBaseType,s_array) then begin - Result := ExtractSoapArray(internalName,hasInternalName); + Result := ExtractSoapArray(ATypeName,internalName,hasInternalName); end else begin - arrayItems := TObjectList.Create(False); + arrayItems := TPropInfoReferenceList.Create(); try classDef := TPasClassType(FSymbols.CreateElement(TPasClassType,internalName,Self.Module.InterfaceSection,visDefault,'',0)); try @@ -824,16 +879,18 @@ begin if Assigned(eltCrs) or Assigned(eltAttCrs) then begin isArrayDef := False; ParseElementsAndAttributes(eltCrs,eltAttCrs); - if ( arrayItems.Count > 0 ) then begin - if ( arrayItems.Count = 1 ) and ( GetElementCount(classDef.Members,TPasProperty) = 1 ) then begin + if ( arrayItems.GetCount() > 0 ) then begin + if ( arrayItems.GetCount() = 1 ) and ( GetElementCount(classDef.Members,TPasProperty) = 1 ) then begin Result := nil; - propTyp := arrayItems[0] as TPasProperty; + propTyp := arrayItems.GetItem(0).Prop; arrayDef := FSymbols.CreateArray(internalName,propTyp.VarType,propTyp.Name,FSymbols.GetExternalName(propTyp),asScoped); FSymbols.FreeProperties(classDef); FreeAndNil(classDef); Result := arrayDef; if hasInternalName then FSymbols.RegisterExternalAlias(arrayDef,ATypeName); + if arrayItems.GetItem(0).IsCollection then + FSymbols.SetCollectionFlag(arrayDef,True); end else begin GenerateArrayTypes(internalName,arrayItems); tmpClassDef := classDef; @@ -1338,6 +1395,56 @@ begin end; end; +{ TPropInfoReferenceList } + +constructor TPropInfoReferenceList.Create(); +begin + FList := TObjectList.Create(False); +end; + +destructor TPropInfoReferenceList.Destroy(); +begin + FList.Free(); + inherited Destroy(); +end; + +function TPropInfoReferenceList.Add(AProp : TPasProperty) : TPropInfoReference; +var + i : PtrInt; +begin + i := IndexOf(AProp); + if ( i = -1 ) then begin + Result := TPropInfoReference.Create(); + Result.FProp := AProp; + FList.Add(Result); + end else begin + Result := TPropInfoReference(FList[i]); + end; +end; + +function TPropInfoReferenceList.GetItem(const AIndex : PtrInt) : TPropInfoReference; +begin + Result := TPropInfoReference(FList[AIndex]); +end; + +function TPropInfoReferenceList.IndexOf(const AProp : TPasProperty) : PtrInt; +var + i : PtrInt; +begin + Result := -1; + for i := 0 to Pred(FList.Count) do begin + if ( TPropInfoReference(FList[i]).Prop = AProp ) then begin + Result := i; + Break; + end; + end; +end; + +function TPropInfoReferenceList.GetCount() : PtrInt; +begin + Result := FList.Count; +end; + initialization TAbstractTypeParser.RegisterParser(TSimpleTypeParser); TAbstractTypeParser.RegisterParser(TComplexTypeParser); diff --git a/wst/trunk/ws_helper/xsd_consts.pas b/wst/trunk/ws_helper/xsd_consts.pas index f657396b6..8fda9bc8f 100644 --- a/wst/trunk/ws_helper/xsd_consts.pas +++ b/wst/trunk/ws_helper/xsd_consts.pas @@ -92,9 +92,13 @@ const s_xmlns = 'xmlns'; + s_WST = 'wst'; + s_WST_base_namespace = 'urn:wst_base'; + s_WST_collection = 'wst_collection'; s_WST_headerBlock = 'wst_headerBlock'; s_WST_record = 'wst_record'; s_WST_storeType = 'StoreType'; + implementation diff --git a/wst/trunk/ws_helper/xsd_generator.pas b/wst/trunk/ws_helper/xsd_generator.pas index 23b5f172f..9dd7c55da 100644 --- a/wst/trunk/ws_helper/xsd_generator.pas +++ b/wst/trunk/ws_helper/xsd_generator.pas @@ -123,6 +123,9 @@ type );virtual;abstract; function GetOwner() : IXsdGenerator; class function CanHandle(ASymbol : TObject) : Boolean;virtual;abstract; + function GetSchemaNode(ADocument : TDOMDocument) : TDOMNode; + procedure DeclareNameSpaceOf_WST(ADocument : TDOMDocument); + procedure DeclareAttributeOf_WST(AElement : TDOMElement; const AAttName, AAttValue : DOMString); public constructor Create(AOwner : IGenerator);virtual; end; @@ -171,7 +174,6 @@ type ADocument : TDOMDocument );override; class function CanHandle(ASymbol : TObject) : Boolean;override; - function GetSchemaNode(ADocument : TDOMDocument) : TDOMNode; end; { TTypeAliasDefinition_TypeHandler } @@ -390,6 +392,29 @@ begin Result := IXsdGenerator(FOwner); end; +function TBaseTypeHandler.GetSchemaNode(ADocument : TDOMDocument) : TDOMNode; +begin + Result := GetOwner().GetSchemaNode(ADocument); +end; + +procedure TBaseTypeHandler.DeclareNameSpaceOf_WST(ADocument : TDOMDocument); +var + defSchemaNode : TDOMElement; + strBuffer : string; +begin + defSchemaNode := GetSchemaNode(ADocument) as TDOMElement; + if not FindAttributeByValueInNode(s_WST_base_namespace,defSchemaNode,strBuffer) then + defSchemaNode.SetAttribute(Format('%s:%s',[s_xmlns,s_WST]),s_WST_base_namespace); +end; + +procedure TBaseTypeHandler.DeclareAttributeOf_WST( + AElement : TDOMElement; + const AAttName, AAttValue : DOMString +); +begin + AElement.SetAttribute(Format('%s:%s',[s_WST,AAttName]),AAttvalue); +end; + constructor TBaseTypeHandler.Create(AOwner: IGenerator); begin Assert(Assigned(AOwner)); @@ -412,11 +437,6 @@ begin Result := Assigned(ASymbol) and ASymbol.InheritsFrom(TPasType); end; -function TTypeDefinition_TypeHandler.GetSchemaNode(ADocument : TDOMDocument) : TDOMNode; -begin - Result := GetOwner().GetSchemaNode(ADocument); -end; - { TTypeAliasDefinition_TypeHandler } procedure TTypeAliasDefinition_TypeHandler.Generate( @@ -612,12 +632,13 @@ var end else begin if AnsiSameText('Has',Copy(p.StoredAccessorName,1,3)) then propNode.SetAttribute(s_minOccurs,'0'); - {else - propNode.SetAttribute(s_minOccurs,'1');} - if isEmbeddedArray then - propNode.SetAttribute(s_maxOccurs,s_unbounded) - {else - propNode.SetAttribute(s_maxOccurs,'1');} + if isEmbeddedArray then begin + propNode.SetAttribute(s_maxOccurs,s_unbounded); + if AContainer.IsCollection(TPasArrayType(propItmUltimeType)) then begin + DeclareNameSpaceOf_WST(ADocument); + DeclareAttributeOf_WST(propNode,s_WST_collection,'true'); + end; + end; end; end; ProcessPropertyExtendedMetadata(p,propNode); @@ -649,7 +670,8 @@ begin if Assigned(typItm.AncestorType) then begin trueParent := typItm.AncestorType; if trueParent.InheritsFrom(TPasNativeClassType) and AnsiSameText('THeaderBlock',trueParent.Name) then begin - cplxNode.SetAttribute(s_WST_headerBlock,'true'); + DeclareNameSpaceOf_WST(ADocument); + DeclareAttributeOf_WST(cplxNode,s_WST_headerBlock,'true'); end; if trueParent.InheritsFrom(TPasAliasType) then trueParent := GetUltimeType(trueParent); @@ -658,12 +680,21 @@ begin then begin typeCategory := tcSimpleContent; end; - derivationNode := CreateElement(Format('%s:%s',[s_xs_short,s_extension]),cplxNode,ADocument); - s := Trim(GetNameSpaceShortName(GetTypeNameSpace(AContainer,trueParent),ADocument,GetOwner().GetPreferedShortNames())); - if ( Length(s) > 0 ) then - s := s + ':'; - s := s + AContainer.GetExternalName(trueParent); - derivationNode.SetAttribute(s_base,s); + if trueParent.InheritsFrom(TPasNativeSimpleContentClassType) or + ( not trueParent.InheritsFrom(TPasNativeClassType) ) + then begin + if ( typeCategory = tcSimpleContent ) then begin + derivationNode := CreateElement(Format('%s:%s',[s_xs_short,s_simpleContent]),cplxNode,ADocument); + derivationNode := CreateElement(Format('%s:%s',[s_xs_short,s_extension]),derivationNode,ADocument); + end else begin + derivationNode := CreateElement(Format('%s:%s',[s_xs_short,s_extension]),cplxNode,ADocument); + end; + s := Trim(GetNameSpaceShortName(GetTypeNameSpace(AContainer,trueParent),ADocument,GetOwner().GetPreferedShortNames())); + if ( Length(s) > 0 ) then + s := s + ':'; + s := s + AContainer.GetExternalName(trueParent); + derivationNode.SetAttribute(s_base,s); + end; hasSequence := False; end; if ( typItm.Members.Count > 0 ) then @@ -719,7 +750,8 @@ begin cplxNode := CreateElement(s,defSchemaNode,ADocument); cplxNode.SetAttribute(s_name, AContainer.GetExternalName(typItm)) ; - cplxNode.SetAttribute(s_WST_record,'true'); + DeclareNameSpaceOf_WST(ADocument); + DeclareAttributeOf_WST(cplxNode,s_WST_record,'true'); hasSequence := False; for i := 0 to Pred(typItm.Members.Count) do begin @@ -791,7 +823,7 @@ procedure TBaseArrayRemotable_TypeHandler.Generate( ADocument : TDOMDocument ); - function GetNameSpaceShortName(const ANameSpace : string):string;//inline; + function GetNameSpaceShortName(const ANameSpace : string):string; begin if FindAttributeByValueInNode(ANameSpace,ADocument.DocumentElement,Result,0,s_xmlns) then begin Result := Copy(Result,Length(s_xmlns+':')+1,MaxInt); @@ -827,6 +859,10 @@ begin s := Format('%s:%s',[s_xs_short,s_element]); propNode := CreateElement(s,sqcNode,ADocument); propNode.SetAttribute(s_name,s_item); + if AContainer.IsCollection(typItm) then begin + DeclareNameSpaceOf_WST(ADocument); + DeclareAttributeOf_WST(propNode,s_WST_collection,'true'); + end; if Assigned(propTypItm) then begin prop_ns_shortName := GetNameSpaceShortName(GetTypeNameSpace(AContainer,propTypItm));// AContainer.GetExternalName(propTypItm.Parent.Parent)); propNode.SetAttribute(s_type,Format('%s:%s',[prop_ns_shortName,AContainer.GetExternalName(propTypItm)])); diff --git a/wst/trunk/wst_rtti_filter/rtti_filters.pas b/wst/trunk/wst_rtti_filter/rtti_filters.pas index a3df11905..0408a5716 100644 --- a/wst/trunk/wst_rtti_filter/rtti_filters.pas +++ b/wst/trunk/wst_rtti_filter/rtti_filters.pas @@ -514,10 +514,14 @@ end; function TRttiExpIntegerNodeItem.Evaluate(AInstance: TRttiFilterCreatorTarget): Boolean; begin case Operation of - nfoEqual : Result := ( GetOrdProp(AInstance,PropInfo) = ComparedValue ); - nfoGreater : Result := ( GetOrdProp(AInstance,PropInfo) > ComparedValue ); - nfoLesser : Result := ( GetOrdProp(AInstance,PropInfo) < ComparedValue ); - nfoNotEqual : Result := ( GetOrdProp(AInstance,PropInfo) <> ComparedValue ); + nfoEqual : Result := ( GetOrdProp(AInstance,PropInfo) = ComparedValue ); + nfoGreater : Result := ( GetOrdProp(AInstance,PropInfo) > ComparedValue ); + nfoLesser : Result := ( GetOrdProp(AInstance,PropInfo) < ComparedValue ); + nfoNotEqual : Result := ( GetOrdProp(AInstance,PropInfo) <> ComparedValue ); + nfoGreaterOrEqual : Result := ( GetOrdProp(AInstance,PropInfo) >= ComparedValue ); + nfoLesserOrEqual : Result := ( GetOrdProp(AInstance,PropInfo) <= ComparedValue ); + else + Assert(False); end; end; @@ -737,6 +741,8 @@ begin sfoEqualCaseSensitive : Result := ( GetStrProp(AInstance,PropInfo) = ComparedValue ); sfoEqualCaseInsensitive : Result := AnsiSameText(GetStrProp(AInstance,PropInfo),ComparedValue); sfoNotEqual : Result := ( GetStrProp(AInstance,PropInfo) <> ComparedValue); + else + Assert(False); end; end; @@ -761,6 +767,8 @@ begin sfoEqualCaseSensitive : Result := AnsiSameStr(GetStrProp(AInstance,PropInfo),ComparedValue); sfoEqualCaseInsensitive : Result := AnsiSameText(GetStrProp(AInstance,PropInfo),ComparedValue); sfoNotEqual : Result := not AnsiSameText(GetStrProp(AInstance,PropInfo),ComparedValue); + else + Assert(False); end; end; diff --git a/wst/trunk/wst_rtti_filter/wst_cursors.pas b/wst/trunk/wst_rtti_filter/wst_cursors.pas index 168e27935..7a58ce8f2 100644 --- a/wst/trunk/wst_rtti_filter/wst_cursors.pas +++ b/wst/trunk/wst_rtti_filter/wst_cursors.pas @@ -50,16 +50,40 @@ type destructor Destroy();override; end; + { TObjectCollectionRemotableCursor } + + TObjectCollectionRemotableCursor = class(TInterfacedObject,ICursor,IObjectCursor) + private + FList : TObjectCollectionRemotable; + FCurrentIndex : PtrInt; + protected + procedure Reset(); + function MoveNext() : Boolean;virtual; + function Clone():ICursor; + function GetCount() : PtrInt; + function GetCurrent() : TObject; + public + constructor Create(ADataList : TObjectCollectionRemotable); + end; + function Find( const AList : TBaseObjectArrayRemotable; const AFilter : string - ) : TBaseRemotable; - + ) : TBaseRemotable;overload; + function Find( + const AList : TObjectCollectionRemotable; + const AFilter : string + ) : TBaseRemotable;overload; + function Filter( const AList : TBaseObjectArrayRemotable; const AFilter : string - ) : IFilterableObjectCursor; - + ) : IFilterableObjectCursor;overload; + function Filter( + const AList : TObjectCollectionRemotable; + const AFilter : string + ) : IFilterableObjectCursor;overload; + implementation uses imp_utils, rtti_filters; @@ -88,6 +112,30 @@ begin Result := locRes; end; +function Find( + const AList : TObjectCollectionRemotable; + const AFilter : string +) : TBaseRemotable ; +var + locRes : TBaseRemotable; + crs : IObjectCursor; + fltr : IObjectFilter; +begin + locRes := nil; + if ( AList <> nil ) and ( AList.Length > 0 ) then begin + if IsStrEmpty(AFilter) then begin + locRes := AList[0]; + end else begin + fltr := ParseFilter(AFilter,AList.GetItemClass()); + crs := CreateCursorOn(TObjectCollectionRemotableCursor.Create(AList),fltr); + crs.Reset(); + if crs.MoveNext() then + locRes := TBaseRemotable(crs.GetCurrent()); + end; + end; + Result := locRes; +end; + function Filter( const AList : TBaseObjectArrayRemotable; const AFilter : string @@ -109,6 +157,27 @@ begin Result := crs; end; +function Filter( + const AList : TObjectCollectionRemotable; + const AFilter : string +) : IFilterableObjectCursor ; +var + crs : IFilterableObjectCursor; + fltr : IObjectFilter; +begin + crs := nil; + if ( AList <> nil ) then begin + if IsStrEmpty(AFilter) then begin + crs := CreateCursorOn(TObjectCollectionRemotableCursor.Create(AList),nil); + end else begin + fltr := ParseFilter(AFilter,AList.GetItemClass()); + crs := CreateCursorOn(TObjectCollectionRemotableCursor.Create(AList),fltr); + crs.Reset(); + end; + end; + Result := crs; +end; + { TBaseObjectArrayRemotableCursor } procedure TBaseObjectArrayRemotableCursor.Reset(); @@ -182,5 +251,42 @@ begin inherited Destroy(); end; +{ TObjectCollectionRemotableCursor } + +procedure TObjectCollectionRemotableCursor.Reset(); +begin + FCurrentIndex := -1; +end; + +function TObjectCollectionRemotableCursor.MoveNext() : Boolean; +begin + Inc(FCurrentIndex); + Result := ( FCurrentIndex < FList.Length ); +end; + +function TObjectCollectionRemotableCursor.Clone() : ICursor; +begin + Result := TObjectCollectionRemotableCursor.Create(FList) as ICursor; +end; + +function TObjectCollectionRemotableCursor.GetCount() : PtrInt; +begin + Result := FList.Length; +end; + +function TObjectCollectionRemotableCursor.GetCurrent() : TObject; +begin + if ( FCurrentIndex < 0 ) or ( FCurrentIndex >= FList.Length ) then + raise ECursorException.Create('Invalid cursor state.'); + Result := FList[FCurrentIndex]; +end; + +constructor TObjectCollectionRemotableCursor.Create(ADataList : TObjectCollectionRemotable); +begin + Assert(Assigned(ADataList)); + FList := ADataList; + Reset(); +end; + end.