Skip to content
Permalink
Browse files

optimized late binding access to all our enhanced variant types

  • Loading branch information
Arnaud Bouchez
Arnaud Bouchez committed Feb 5, 2020
1 parent 93a6007 commit 1376824b2f8ce13f023bd314ca87a28d03f1beca
Showing with 48 additions and 45 deletions.
  1. +14 −14 SQLite3/mORMot.pas
  2. +14 −14 SynDB.pas
  3. +3 −4 SynMustache.pas
  4. +4 −4 SynSM.pas
  5. +2 −2 SynSQLite3Static.pas
  6. +10 −6 SynTable.pas
  7. +1 −1 SynopseCommit.inc
// is used, otherwise random GPF issues may occur
TSQLTableRowVariant = class(TSynInvokeableVariantType)
protected
procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar); override;
procedure IntSet(const V, Value: TVarData; Name: PAnsiChar); override;
procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar; NameLen: PtrInt); override;
procedure IntSet(const V, Value: TVarData; Name: PAnsiChar; NameLen: PtrInt); override;
public
/// customization of variant into JSON serialization
procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); override;
// which convert all properties into a TDocVariant, so may use more resource
TObjectVariant = class(TSynInvokeableVariantType)
protected
function GetInfo(const V: TVarData; Name: PUTF8Char): PPropInfo;
procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar); override;
procedure IntSet(const V, Value: TVarData; Name: PAnsiChar); override;
function GetInfo(const V: TVarData; Name: PUTF8Char; NameLen: PtrInt): PPropInfo;
procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar; NameLen: PtrInt); override;
procedure IntSet(const V, Value: TVarData; Name: PAnsiChar; NameLen: PtrInt); override;
public
/// initialize a new custom variant instance, wrapping the specified object
// - warning: this custom variant is just a wrapper around an existing TObject
{ TSQLTableRowVariant }

procedure TSQLTableRowVariant.IntGet(var Dest: TVarData;
const V: TVarData; Name: PAnsiChar);
const V: TVarData; Name: PAnsiChar; NameLen: PtrInt);
var r,f: integer;
begin
if (TSQLTableRowVariantData(V).VTable=nil) or (Name=nil) then
TSQLTableRowVariantData(V).VTable.GetVariant(r,f,Variant(Dest));
end;

procedure TSQLTableRowVariant.IntSet(const V, Value: TVarData; Name: PAnsiChar);
procedure TSQLTableRowVariant.IntSet(const V, Value: TVarData;
Name: PAnsiChar; NameLen: PtrInt);
begin
raise ESQLTableException.CreateUTF8('% is read-only',[self]);
end;
W.WriteObject(TVarData(Value).VPointer);
end;

function TObjectVariant.GetInfo(const V: TVarData; Name: PUTF8Char): PPropInfo;
function TObjectVariant.GetInfo(const V: TVarData; Name: PUTF8Char; NameLen: PtrInt): PPropInfo;
begin
if (V.VPointer=nil) or (Name=nil) then
raise EObjectVariant.CreateUTF8('Invalid %.% call',[self,Name]);
result := ClassFieldPropWithParentsFromUTF8(PPointer(V.VPointer)^,
Name, StrLen(Name));
result := ClassFieldPropWithParentsFromUTF8(PPointer(V.VPointer)^,Name,NameLen);
if (result=nil) and IsRowID(Name) and TObject(V.VPointer).InheritsFrom(TSQLRecord) then
result := pointer(1); // recognize TSQLRecord.ID pseudo-property
if result=nil then
raise EObjectVariant.CreateUTF8('Unknown %.%',[self,Name]);
end;

procedure TObjectVariant.IntGet(var Dest: TVarData; const V: TVarData;
Name: PAnsiChar);
Name: PAnsiChar; NameLen: PtrInt);
var info: PPropInfo;
begin
info := GetInfo(V,PUTF8Char(Name));
info := GetInfo(V,PUTF8Char(Name),NameLen);
if info=pointer(1) then
variant(Dest) := TSQLRecord(V.VPointer).IDValue else
if info^.PropType^.Kind=tkClass then
New(Variant(Dest),info^.GetObjProp(V.VPointer)) else
info^.GetVariant(V.VPointer,Variant(Dest));
end;

procedure TObjectVariant.IntSet(const V, Value: TVarData; Name: PAnsiChar);
procedure TObjectVariant.IntSet(const V, Value: TVarData; Name: PAnsiChar; NameLen: PtrInt);
var info: PPropInfo;
begin
info := GetInfo(V,PUTF8Char(Name));
info := GetInfo(V,PUTF8Char(Name),NameLen);
if info=pointer(1) then
VariantToInt64(Variant(Value),PInt64(@TSQLRecord(V.VPointer).fID)^) else
info^.SetFromVariant(V.VPointer,Variant(Value));
@@ -588,8 +588,8 @@ TSQLDBStatement = class;
// - use ISQLDBRows.RowData method to retrieve such a Variant
TSQLDBRowVariantType = class(TSynInvokeableVariantType)
protected
procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar); override;
procedure IntSet(const V, Value: TVarData; Name: PAnsiChar); override;
procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar; NameLen: PtrInt); override;
procedure IntSet(const V, Value: TVarData; Name: PAnsiChar; NameLen: PtrInt); override;
end;
{$endif}
{$endif}
@@ -4029,7 +4029,7 @@ procedure TQuery.Execute(ExpectResults: Boolean);
end;
inc(P);
end;
SetString(tmp,PAnsiChar(B),P-B);
FastSetString(tmp,B,P-B);
if P^=#0 then begin
new := new+tmp;
break;
@@ -6360,7 +6360,7 @@ function TSQLDBConnectionProperties.GetDBMSName: RawUTF8;
var PS: PShortString;
begin
PS := ToText(DBMS);
SetString(result,PAnsiChar(@PS^[2]),ord(PS^[0])-1);
FastSetString(result,@PS^[2],ord(PS^[0])-1);
end;

function TSQLDBConnectionProperties.GetDatabaseNameSafe: RawUTF8;
@@ -7512,7 +7512,7 @@ function TSQLDBStatement.GetParamValueAsText(Param,MaxCharCount: integer): RawUT
dec(L); // avoid return of invalid UTF-8 buffer
if L=0 then
L := MaxCharCount;
SetString(result,PAnsiChar(VAny),L);
FastSetString(result,VAny,L);
end else
result := RawUTF8(VAny);
end;
@@ -7688,19 +7688,19 @@ function TSQLDBStatement.BoundCursor(Param: Integer): ISQLDBRows;
{ TSQLDBRowVariantType }

procedure TSQLDBRowVariantType.IntGet(var Dest: TVarData;
const V: TVarData; Name: PAnsiChar);
const V: TVarData; Name: PAnsiChar; NameLen: PtrInt);
var Rows: TSQLDBStatement;
col: RawUTF8;
begin
Rows := TSQLDBStatement(TVarData(V).VPointer);
if Rows=nil then
raise ESQLDBException.CreateUTF8('Invalid % call',[self]);
SetString(col,Name,StrLen(Name));
FastSetString(col,Name,NameLen);
Rows.ColumnToVariant(Rows.ColumnIndex(col),Variant(Dest));
end;

procedure TSQLDBRowVariantType.IntSet(const V, Value: TVarData;
Name: PAnsiChar);
Name: PAnsiChar; NameLen: PtrInt);
begin
raise ESQLDBException.CreateUTF8('% is read-only',[self]);
end;
@@ -7805,7 +7805,7 @@ procedure TSQLDBStatementWithParams.BindTextP(Param: Integer;
begin
if (Value=nil) and (fConnection<>nil) and fConnection.fProperties.StoreVoidStringAsNull then
CheckParam(Param,ftNull,IO) else
SetString(CheckParam(Param,ftUTF8,IO)^.VData,PAnsiChar(Value),StrLen(Value));
FastSetString(RawUTF8(CheckParam(Param,ftUTF8,IO)^.VData),Value,StrLen(Value));
end;

procedure TSQLDBStatementWithParams.BindTextW(Param: Integer;
@@ -8056,11 +8056,11 @@ function TrimLeftSchema(const TableName: RawUTF8): RawUTF8;
end;

function ReplaceParamsByNames(const aSQL: RawUTF8; var aNewSQL: RawUTF8): integer;
var i,j,B,L: integer;
var i,j,B,L: PtrInt;
P: PAnsiChar;
c: array[0..3] of AnsiChar;
tmp: RawUTF8;
const SQL_KEYWORDS: array[0..17] of AnsiChar = 'ASBYIFINISOFONORTO';
const SQL_KEYWORDS: array[0..19] of AnsiChar = 'ASATBYIFINISOFONORTO';
begin
result := 0;
L := Length(aSQL);
@@ -8085,7 +8085,7 @@ function ReplaceParamsByNames(const aSQL: RawUTF8; var aNewSQL: RawUTF8): intege
end;
inc(i);
end;
SetString(tmp,P+B,i-B);
FastSetString(tmp,P+B,i-B);
aNewSQL := aNewSQL+tmp;
if i=L then break;
// store :AA :BA ..
@@ -8242,7 +8242,7 @@ function TSQLDBRemoteConnectionPropertiesAbstract.Process(
cGetForeignKeys:
OutputSynNameValue.SetBlobDataPtr(O);
cExecute, cExecuteToBinary, cExecuteToJSON, cExecuteToExpandedJSON:
SetString(OutputRawUTF8,O,length(msgOutput)-sizeof(header));
FastSetString(OutputRawUTF8,O,length(msgOutput)-sizeof(header));
cExceptionRaised: // msgOutput is ExceptionClassName+#0+ExceptionMessage
raise ESQLDBRemote.CreateUTF8('%.Process(%): server raised % with ''%''',
[self,ToText(Command)^,O,O+StrLen(O)+1]);
@@ -8596,7 +8596,7 @@ function TSQLDBProxyStatementAbstract.ColumnUTF8(Col: integer): RawUTF8;
ftDouble: result := DoubleToStr(unaligned(PDouble(Data)^));
ftCurrency: result := Curr64ToStr(PInt64(Data)^);
ftDate: DateTimeToIso8601TextVar(PDateTime(Data)^,'T',result);
ftBlob, ftUTF8: with FromVarBlob(Data) do SetString(result,Ptr,Len);
ftBlob, ftUTF8: with FromVarBlob(Data) do FastSetString(result,Ptr,Len);
else raise ESQLDBException.CreateUTF8('%.ColumnUTF8()',[self]);
end;
end;
@@ -115,6 +115,7 @@ TSynMustacheTag = record
/// states the section content according to a given value
// - msNothing for false values or empty lists
// - msSingle for non-false values but not a list
// - msSinglePseudo is for *-first *-last *-odd and helper values
// - msList for non-empty lists
TSynMustacheSectionType = (msNothing,msSingle,msSinglePseudo,msList);

@@ -1300,6 +1301,7 @@ function TSynMustacheContextVariant.GetValueFromContext(
Value := res^;
if valFree then
VarClear(variant(val));
result := msSinglePseudo;
end;

begin
@@ -1316,7 +1318,6 @@ function TSynMustacheContextVariant.GetValueFromContext(
helper := TSynMustache.HelperFind(Helpers,pointer(ValueName),space-1);
if helper>=0 then begin
ProcessHelper;
result := msSinglePseudo;
exit;
end; // if helper not found, will return the unprocessed value
end;
@@ -1343,10 +1344,8 @@ function TSynMustacheContextVariant.GetValueFromContext(
if space=0 then begin
space := length(ValueName); // {{helper}}
helper := TSynMustache.HelperFind(Helpers,pointer(ValueName),space);
if helper>=0 then begin
if helper>=0 then
ProcessHelper;
result := msSinglePseudo;
end;
end;
end;

@@ -884,8 +884,8 @@ TSMEngineManager = class
TSMVariant = class(TSynInvokeableVariantType)
protected
/// fast getter/setter implementation of object properties
procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar); override;
procedure IntSet(const V, Value: TVarData; Name: PAnsiChar); override;
procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar; NameLen: PtrInt); override;
procedure IntSet(const V, Value: TVarData; Name: PAnsiChar; NameLen: PtrInt); override;
public
/// initialize a variant instance to store a JavaScript object
class procedure New(const aObject: TSMObject; out aValue: variant); overload;
@@ -2411,7 +2411,7 @@ procedure TSMObject.DeleteItem(aIndex: integer);
{ TSMVariant }

procedure TSMVariant.IntGet(var Dest: TVarData; const V: TVarData;
Name: PAnsiChar);
Name: PAnsiChar; NameLen: PtrInt);
var res: TSMValue;
begin
//Assert(V.VType=SMVariantType.VarType);
@@ -2458,7 +2458,7 @@ function TSMVariant.DoFunction(var Dest: TVarData; const V: TVarData;
end;
end;

procedure TSMVariant.IntSet(const V, Value: TVarData; Name: PAnsiChar);
procedure TSMVariant.IntSet(const V, Value: TVarData; Name: PAnsiChar; NameLen: PtrInt);
var smValue: TSMValue;
begin
with TSMVariantData(V) do begin
@@ -808,8 +808,8 @@ procedure CodeEncryptDecrypt(page: cardinal; data: PAnsiChar; len: integer;
iv: THash128Rec; // is genuine and AES-protected (since not random)
begin
if (len and AESBlockMod<>0) or (len<=0) or (integer(page)<=0) then
raise ESQLite3Exception.CreateUTF8('CodeEncryptDecrypt(%) has len=%', [page,len]);
iv.c0 := page xor 668265263;
raise ESQLite3Exception.CreateUTF8('CodeEncryptDecrypt(page=%,len=%)', [page,len]);
iv.c0 := page xor 668265263; // prime-based initialization
iv.c1 := page*2654435761;
iv.c2 := page*2246822519;
iv.c3 := page*3266489917;
@@ -1741,8 +1741,8 @@ TSynTable = class
// - uses internally a TSynTableData object
TSynTableVariantType = class(TSynInvokeableVariantType)
protected
procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar); override;
procedure IntSet(const V, Value: TVarData; Name: PAnsiChar); override;
procedure IntGet(var Dest: TVarData; const V: TVarData; Name: PAnsiChar; NameLen: PtrInt); override;
procedure IntSet(const V, Value: TVarData; Name: PAnsiChar; NameLen: PtrInt); override;
public
/// retrieve the SBF compact binary format representation of a record content
class function ToSBF(const V: Variant): TSBFString;
@@ -3891,15 +3891,19 @@ procedure TSynTableVariantType.Copy(var Dest: TVarData;
end;

procedure TSynTableVariantType.IntGet(var Dest: TVarData;
const V: TVarData; Name: PAnsiChar);
const V: TVarData; Name: PAnsiChar; NameLen: PtrInt);
var aName: RawUTF8;
begin
TSynTableData(V).GetFieldVariant(RawByteString(Name),variant(Dest));
FastSetString(aName,Name,NameLen);
TSynTableData(V).GetFieldVariant(aName,variant(Dest));
end;

procedure TSynTableVariantType.IntSet(const V, Value: TVarData;
Name: PAnsiChar);
Name: PAnsiChar; NameLen: PtrInt);
var aName: RawUTF8;
begin
TSynTableData(V).SetFieldValue(RawByteString(Name),Variant(Value));
FastSetString(aName,Name,NameLen);
TSynTableData(V).SetFieldValue(aName,Variant(Value));
end;

class function TSynTableVariantType.ToID(const V: Variant): integer;
@@ -1 +1 @@
'1.18.5436'
'1.18.5437'

0 comments on commit 1376824

Please sign in to comment.
You can’t perform that action at this time.