Commits

Anonymous committed a9e9bfc

Testing lookup functionality

Comments (0)

Files changed (2)

Src/ASProvider.pas

 type
   TASCustomProvider = class(TBaseProvider)
   private
+    class var FLookupDataSets: TCollection;
+
+  private
     FActive: Boolean;
     FStreamedActive: Boolean;
     FDataSet: TPacketDataSet;
     function GetFieldDefs: TFieldDefs;
     procedure SetFieldDefs(const Value: TFieldDefs);
     procedure SetActive(const Value: Boolean);
+    class function GetLookupDataSets: TCollection; static;
+
+  protected
+    class property LookupDataSets: TCollection read GetLookupDataSets;
 
   protected
     function CreateResolver: TCustomResolver; override;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    class destructor ClassDestroy;
 
     procedure Open;
     procedure Close;
     property Options default [poDisableInserts, poDisableDeletes, poUseQuoteChar];
   end;
 
+  TASTypeLookupProvider = class(TASCustomProvider)
+  private
+    FTypeInfo: PTypeInfo;
+    procedure SetTypeInfo(const Value: PTypeInfo);
+
+  protected
+    procedure ExtractMetaData; override;
+    procedure ExtractData; override;
+
+    procedure AddField(FieldDefs: TFieldDefs; const FieldName: string; FieldType: TFieldType);
+
+  public
+    property TypeInfo: PTypeInfo read FTypeInfo write SetTypeInfo;
+  end;
+
+  TASTypeLookupProvider<T> = class(TASTypeLookupProvider)
+  public
+    constructor Create(AOwner: TComponent); override;
+  end;
+
   TASObjectProvider = class(TASCustomProvider)
   private
     FClass: TClass;
     function GetDeltaIndex(Tree: TUpdateTree): Integer; override;
   end;
 
+  TASTypeLookupDataSetItem = class(TCollectionItem)
+  private
+    FDataSet: TDataSet;
+  public
+    procedure CreateDataSet(Owner: TComponent; ATypeInfo: PTypeInfo);
+    property DataSet: TDataSet read FDataSet;
+  end;
+
 procedure Register;
 
 implementation
   Result := TASResolver.Create(Self);
 end;
 
+class destructor TASCustomProvider.ClassDestroy;
+//var
+//  I: TCollectionItem;
+begin
+//  if Assigned(FLookupDataSets) then
+//    for I in FLookupDataSets do
+//      with I as TASTypeLookupDataSetItem do
+//        DataSet.Close;
+//
+  FreeAndNil(FLookupDataSets);
+end;
+
 destructor TASCustomProvider.Destroy;
 begin
+  FreeAndNil(FDataSet);
   FreeAndNil(FDSWriter);
   FreeAndNil(FFieldDefs);
-  FreeAndNil(FDataSet);
 
   inherited;
 end;
   Result := FFieldDefs;
 end;
 
+class function TASCustomProvider.GetLookupDataSets: TCollection;
+begin
+  if not Assigned(FLookupDataSets) then
+    FLookupDataSets := TCollection.Create(TASTypeLookupDataSetItem);
+
+  Result := FLookupDataSets;
+end;
+
 procedure TASCustomProvider.InitializeDataset;
 begin
   DataSet.Active := False;
         if FieldDefs.IndexOf(P.Name) >= 0 then
           Continue;
 
+        N := P.Name;
+        if (P.PropertyType.TypeKind = tkEnumeration) and (N <> 'Boolean') then begin
+          L := TStringField.Create(DataSet);
+          try
+            N := P.Name + '-lookup.target';
+            L.FieldName := P.Name;
+            L.KeyFields := N;
+            L.LookupKeyFields := 'Key';
+            L.LookupResultField := 'Value';
+
+            L.LookupDataSet := Application.FindComponent(GetLookupDataSetName(P.PropertyType.Handle^.Name)) as TDataSet;
+            if L.LookupDataSet = nil then
+              with LookupDataSets.Add as TASTypeLookupDataSetItem do
+                CreateDataSet(Application, P.PropertyType.Handle);
+
+            L.LookupDataSet := Application.FindComponent(GetLookupDataSetName(P.PropertyType.Handle^.Name)) as TDataSet;
+            Assert(L.LookupDataSet <> nil, 'Failed to create lookup dataset');
+            L.Lookup := True;
+            DataSet.Fields.Add(L);
+          except
+            L.Free;
+            raise;
+          end;
+        end;
+
         with FieldDefs.AddFieldDef do try
-          Name := P.Name;
+          Name := N;
           DataType := F;
           if F = ftWideString then
             Size := 20;
   ExtractMetaData;
 end;
 
+{ TASTypeLookupProvider }
+
+procedure TASTypeLookupProvider.AddField(FieldDefs: TFieldDefs; const FieldName: string; FieldType: TFieldType);
+begin
+  with FieldDefs.AddFieldDef do try
+    Name := FieldName;
+    DataType := FieldType;
+    if FieldType = ftWideString then
+      Size := 20;
+
+    Attributes := [faReadonly];
+  except
+    Free;
+    raise;
+  end;
+end;
+
+procedure TASTypeLookupProvider.ExtractData;
+var
+  D: PTypeData;
+  I: Integer;
+
+begin
+  Assert(TypeInfo^.Kind = tkEnumeration, 'Type lookup only for enumerations');
+  D := GetTypeData(TypeInfo);
+
+  InitializeDataset;
+  for I := D^.MinValue to D^.MaxValue do begin
+    DataSet.Append;
+    try
+      with DataSet.FieldByName('Key') do try
+        ReadOnly := False;
+        AsVariant := I;
+      finally
+        ReadOnly := True;
+      end;
+
+      with DataSet.FieldByName('Value') do try
+        ReadOnly := False;
+        AsString := GetEnumName(TypeInfo, I);
+      finally
+        ReadOnly := True;
+      end;
+
+      DataSet.Post;
+    except
+      DataSet.Cancel;
+      raise;
+    end;
+  end;
+end;
+
+procedure TASTypeLookupProvider.ExtractMetaData;
+var
+  F: TFieldType;
+
+begin
+  Assert(TypeInfo.Kind = tkEnumeration, 'Type lookup only for enumerations');
+  F := RttiTypeToFieldType(TypeInfo);
+  if F = ftUnknown then
+    Exit;
+
+  FieldDefs.BeginUpdate;
+  try
+    AddField(FieldDefs, 'Key', F);
+    AddField(FieldDefs, 'Value', ftString);
+  finally
+    FieldDefs.EndUpdate;
+  end;
+end;
+
+procedure TASTypeLookupProvider.SetTypeInfo(const Value: PTypeInfo);
+begin
+  Close;
+  FieldDefs.Clear;
+  FTypeInfo := Value;
+end;
+
+{ TASTypeLookupProvider<T> }
+
+constructor TASTypeLookupProvider<T>.Create(AOwner: TComponent);
+begin
+  inherited;
+  TypeInfo := System.TypeInfo(T);
+end;
+
+{ TASTypeLookupDataSetItem }
+
+procedure TASTypeLookupDataSetItem.CreateDataSet(Owner: TComponent; ATypeInfo: PTypeInfo);
+var
+  ProviderName: string;
+begin
+  ProviderName := GetLookupProviderName(ATypeInfo^.Name);
+  if Application.FindComponent(ProviderName) = nil then
+    with TASTypeLookupProvider.Create(Application) do begin
+      Name := ProviderName;
+      TypeInfo := ATypeInfo;
+    end;
+
+  FreeAndNil(FDataSet);
+  FDataSet := TClientDataSet.Create(Owner);
+  DataSet.Name := GetLookupDataSetName(ATypeInfo^.Name);
+  (DataSet as TClientDataSet).ProviderName := ProviderName;
+//  DataSet.Open;
+end;
+
 end.
 

Test/TestASProvider.pas

     property ProvidedTypedObject;
   end;
 
+  TTestBoolData = class
+  private
+    FBool: Boolean;
+  public
+    property MyBool: Boolean read FBool write FBool;
+  end;
+
   TTestItem = class(TCollectionItem)
   private
     Fstring: string;
     procedure TestInsertUpdateDeleteData;
   end;
 
+  TestTASTypeLookupProvider<T> = class(TTestASProviderTestCase)
+  protected
+    function Provider: TASTypeLookupProvider<T>;
+    function GetProviderClass: TASCustomProviderClass; override;
+  end;
+
+  TestTypeIntegerProvider = class(TestTASTypeLookupProvider<Integer>)
+  published
+    procedure TestEAssertionOnlyForEnums;
+  end;
+
+  TestTypeBooleanProvider = class(TestTASTypeLookupProvider<Boolean>)
+  published
+    procedure TestMetaData;
+    procedure TestData;
+  end;
+
   // Test methods for class TASResolver
 
   TestTASResolver = class(TTestCase)
     (Idx: 2; Astring: 'My new string'; Aint: 321)
   );
 
+  TestIntegerTypeMetaData_fields: array[0..1] of TExpectFieldDef = (
+    (Idx: 0; Name: 'Key'; Size: 0; DataType: ftInteger; Attr: [faReadonly]),
+    (Idx: 1; Name: 'Value'; Size: 20; DataType: ftString; Attr: [faReadonly])
+  );
+
+  TestBooleanTypeMetaData_fields: array[0..1] of TExpectFieldDef = (
+    (Idx: 0; Name: 'Key'; Size: 0; DataType: ftBoolean; Attr: [faReadonly]),
+    (Idx: 1; Name: 'Value'; Size: 20; DataType: ftString; Attr: [faReadonly])
+  );
+
 implementation
 
 uses
   FreeAndNil(FProvider);
 end;
 
+{ TestTASTypeLookupProvider<T> }
+
+function TestTASTypeLookupProvider<T>.GetProviderClass: TASCustomProviderClass;
+begin
+  Result := TASTypeLookupProvider<T>;
+end;
+
+function TestTASTypeLookupProvider<T>.Provider: TASTypeLookupProvider<T>;
+begin
+  Result := TASTypeLookupProvider<T>(CustomProvider);
+end;
+
+{ TestTypeIntegerProvider }
+
+procedure TestTypeIntegerProvider.TestEAssertionOnlyForEnums;
+begin
+  StartExpectingException(EAssertionFailed);
+  Provider.Open;
+  StopExpectingException;
+end;
+
+{ TestTypeBooleanProvider }
+
+procedure TestTypeBooleanProvider.TestData;
+var
+  DS: TClientDataSet;
+begin
+  DS := TClientDataSet.Create(Application);
+  try
+    Provider.Name := 'TestProvider';
+    DS.ProviderName := 'TestProvider';
+    DS.Open;
+
+    CheckEquals(2, DS.RecordCount, 'Record count');
+    CheckEquals(False, DS.FieldByName('Key').AsBoolean, 'First Key');
+    CheckEqualsString('False', DS.FieldByName('Value').AsString, 'First Value');
+
+    DS.Next;
+    CheckEquals(True, DS.FieldByName('Key').AsBoolean, 'Second Key');
+    CheckEqualsString('True', DS.FieldByName('Value').AsString, 'Second Value');
+  finally
+    DS.Free;
+  end;
+end;
+
+procedure TestTypeBooleanProvider.TestMetaData;
+begin
+  Provider.Open;
+  CheckMetaData(TestBooleanTypeMetaData_fields);
+end;
+
 initialization
   // Register any test cases with the test runner
   RegisterTest('Provider', TestTASProviders<TASProvider>.Suite);
   RegisterTest('Provider', TestTASProviders<TTestGenericProvider>.Suite);
   RegisterTest('Provider', TestCollectionProvider.Suite);
+  RegisterTest('Provider', TestTypeIntegerProvider.Suite);
+  RegisterTest('Provider', TestTypeBooleanProvider.Suite);
+
   RegisterTest('Resolver', TestTASResolver.Suite);
 end.
 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.