Permalink
Browse files

ensure all samples compile as expected

  • Loading branch information...
Arnaud Bouchez
Arnaud Bouchez committed Aug 5, 2018
1 parent b7a6a3a commit dbc335ee64e48ba876de660422af69cef23cc0d8
@@ -10,6 +10,7 @@ interface
{$endif}
Classes, SysUtils, Forms, Controls, Dialogs, StdCtrls,
SynCommons,
SynTable,
mORMot,
SampleData;
@@ -76,8 +76,8 @@ begin
ILog := TSQLLog.Enter(self);
// do some stuff
ILog.Log(sllCustom1);
ILog.Log(sllInfo,'TestLevel',TypeInfo(TSynLogInfo),TestLevel);
ILog.Log(sllInfo,'set',TypeInfo(TSynLogInfos),S);
ILog.Log(sllInfo,'TestLevel',TypeInfo(TSynLogInfo),TestLevel,nil);
ILog.Log(sllInfo,'set',TypeInfo(TSynLogInfos),S,nil);
ILog.Log(sllDebug,ILog.Instance);
if TestLevel=low(TestLevel) then
TTestLogClass(nil).ClassName; // will raise an access violation
@@ -5,7 +5,7 @@ interface
uses
Windows, Messages, SysUtils, CheckLst, Controls, StdCtrls, Classes, Graphics,
Forms, ExtCtrls, mORMotUILogin,
SynZip, SynCommons, SynDB, SynDBSQLite3;
SynZip, SynCommons, SynDB, SynTable, SynDBSQLite3;
type
TDBExportTablesForm = class(TForm)
@@ -5,7 +5,7 @@ interface
uses
Windows, Messages, SysUtils, CheckLst, Controls, StdCtrls, Classes, Types,
Graphics, Forms, Clipbrd,
SynDB, SynCommons, Menus;
SynDB, SynCommons, SynTable, Menus;
type
TDBQueryTable = object
@@ -14,7 +14,7 @@ interface
AdvToolBar, AdvPreviewMenu, AdvShapeButton, AdvOfficePager,
{$endif}
ImgList, ShellApi,
SynCommons, SynGdiPlus, mORMot, mORMotHttpClient,
SynCommons, SynTable, SynGdiPlus, mORMot, mORMotHttpClient,
mORMotToolBar, mORMotUI, mORMotUILogin, mORMoti18n,
{$ifdef DEBUGINTERNALSERVER}
FileServer,
@@ -9,6 +9,7 @@ interface
SysUtils,
Classes,
SynCommons,
SynTable,
mORMot,
mORMoti18n,
mORMotHttpServer,
@@ -14634,7 +14634,7 @@ TSQLRest = class
// - this method will call EngineAdd() to perform the request
function Add(Value: TSQLRecord; SendData: boolean; ForceID: boolean=false;
DoNotAutoComputeFields: boolean=false): TID; overload;
{$ifdef HASINLINE}inline;{$endif}
{$ifdef FPC}inline;{$endif}
/// create a new member, including selected fields
// - implements REST POST collection
// - if ForceID is true, client sends the Value.ID field to use this ID for
@@ -14649,7 +14649,7 @@ TSQLRest = class
// - this method will call EngineAdd() to perform the request
function Add(Value: TSQLRecord; const CustomFields: TSQLFieldBits;
ForceID: boolean=false; DoNotAutoComputeFields: boolean=false): TID; overload;
{$ifdef HASINLINE}inline;{$endif}
{$ifdef FPC}inline;{$endif}
/// create a new member, including its BLOB fields
// - implements REST POST collection
// - this method will create a JSON representation of the document
@@ -15020,7 +15020,7 @@ TSQLRest = class
function RetrieveList<T: TSQLRecord>(const FormatSQLWhere: RawUTF8;
const BoundsSQLWhere: array of const;
const aCustomFieldsCSV: RawUTF8=''): TObjectList<T>; overload;
{$endif}
{$endif ISDELPHI2010}
/// you can call this method in TThread.Execute to ensure that
// the thread will be taken in account during process
@@ -118,7 +118,7 @@ interface
{$else}
StdCtrls, ComCtrls, SynTaskDialog, Buttons, CommCtrl,
{$endif USETMSPACK}
SynCommons, SynGdiPlus, SynZip,
SynCommons, SynTable, SynGdiPlus, SynZip,
mORMot, mORMotReport, mORMotUI, mORMoti18n, mORMotUILogin;
@@ -104,7 +104,7 @@ interface
{$ifdef USETMSPACK}
TaskDialog,
{$endif}
SynCommons, mORMot, mORMotUILogin, mORMotUI, mORMoti18n, mORMotToolBar,
SynCommons, SynTable, mORMot, mORMotUILogin, mORMotUI, mORMoti18n, mORMotToolBar,
SynTaskDialog, StdCtrls, ExtCtrls, ImgList, ComCtrls;
type
@@ -65,6 +65,7 @@ interface
{$ENDIF}
Classes, Contnrs,
SynCommons,
SynTable,
SynLog,
SynDB,
{$ifdef ISDELPHIXE2}
@@ -470,28 +471,28 @@ function TSQLDBDatasetStatementAbstract.ColumnTypeNativeToDB(aNativeType: TField
ftLongWord,ftShortint,ftByte,
{$endif}
ftAutoInc,ftBoolean, ftSmallint,ftInteger,ftLargeint,ftWord:
result := SynCommons.ftInt64;
result := SynTable.ftInt64;
{$ifdef UNICODE}
ftSingle,ftExtended,
{$endif}
ftFloat:
result := SynCommons.ftDouble;
result := SynTable.ftDouble;
ftCurrency, ftBCD, ftFMTBcd:
result := SynCommons.ftCurrency;
result := SynTable.ftCurrency;
{$ifdef UNICODE}
ftOraTimeStamp,ftOraInterval,
{$endif}
ftDate,ftTime,ftDateTime,ftTimeStamp:
result := SynCommons.ftDate;
result := SynTable.ftDate;
ftBytes,ftVarBytes,ftBlob,ftGraphic,ftOraBlob:
result := SynCommons.ftBlob;
result := SynTable.ftBlob;
{$ifdef UNICODE}
ftFixedWideChar,ftWideMemo,
{$endif}
ftString,ftFixedChar,ftWideString,ftMemo,ftFmtMemo,ftOraClob,ftVariant,ftGuid:
result := SynCommons.ftUTF8;
result := SynTable.ftUTF8;
else // will use TEXT for other fields (any feedback is welcome!)
result := SynCommons.ftUTF8;
result := SynTable.ftUTF8;
end;
end;
@@ -513,9 +514,9 @@ procedure TSQLDBDatasetStatementAbstract.ColumnsToJSON(WR: TJSONWriter);
if TField(ColumnAttr).IsNull then
WR.AddShort('null') else
case ColumnType of
SynCommons.ftNull:
SynTable.ftNull:
WR.AddShort('null');
SynCommons.ftInt64:
SynTable.ftInt64:
if TField(ColumnAttr).DataType=ftBoolean then
WR.Add(ord(TField(ColumnAttr).AsBoolean)) else
{$ifdef UNICODE}
@@ -525,18 +526,18 @@ procedure TSQLDBDatasetStatementAbstract.ColumnsToJSON(WR: TJSONWriter);
WR.Add(TLargeintField(ColumnAttr).AsLargeInt) else
WR.Add(TField(ColumnAttr).AsInteger);
{$endif}
SynCommons.ftDouble:
SynTable.ftDouble:
WR.AddDouble(TField(ColumnAttr).AsFloat);
SynCommons.ftCurrency:
SynTable.ftCurrency:
if TField(ColumnAttr).DataType in [ftBCD,ftFMTBcd] then
AddBcd(WR,TField(ColumnAttr).AsBCD) else
WR.AddCurr64(TField(ColumnAttr).AsCurrency);
SynCommons.ftDate: begin
SynTable.ftDate: begin
WR.Add('"');
WR.AddDateTime(TField(ColumnAttr).AsDateTime,fForceDateWithMS);
WR.Add('"');
end;
SynCommons.ftUTF8: begin
SynTable.ftUTF8: begin
WR.Add('"');
{$ifndef UNICODE}
if ColumnValueDBType=IsTWideStringField then
@@ -545,7 +546,7 @@ procedure TSQLDBDatasetStatementAbstract.ColumnsToJSON(WR: TJSONWriter);
WR.AddJSONEscapeString(TField(ColumnAttr).AsString);
WR.Add('"');
end;
SynCommons.ftBlob:
SynTable.ftBlob:
if fForceBlobAsNull then
WR.AddShort('null') else begin
blob := ColumnBlob(col);
@@ -575,15 +576,15 @@ procedure TSQLDBDatasetStatement.DataSetBindSQLParam(const aArrayIndex,
P.ParamType := SQLParamTypeToDBParamType(VInOut);
if VinOut <> paramInOut then
case VType of
SynCommons.ftNull: begin
SynTable.ftNull: begin
P.Clear;
{$ifdef UNICODE}
P.AsBlob := nil; // avoid type errors when a blob field is adressed
{$else}
P.AsString := '';
{$endif}
end;
SynCommons.ftInt64: begin
SynTable.ftInt64: begin
if aArrayIndex>=0 then
I64 := GetInt64(pointer(VArray[aArrayIndex])) else
I64 := VInt64;
@@ -598,21 +599,21 @@ procedure TSQLDBDatasetStatement.DataSetBindSQLParam(const aArrayIndex,
P.Value := I64;
{$endif}
end;
SynCommons.ftDouble:
SynTable.ftDouble:
if aArrayIndex>=0 then
P.AsFloat := GetExtended(pointer(VArray[aArrayIndex])) else
P.AsFloat := PDouble(@VInt64)^;
SynCommons.ftCurrency:
SynTable.ftCurrency:
if aArrayIndex>=0 then
P.AsCurrency := StrToCurrency(pointer(VArray[aArrayIndex])) else
P.AsCurrency := PCurrency(@VInt64)^;
SynCommons.ftDate:
SynTable.ftDate:
if aArrayIndex>=0 then begin
UnQuoteSQLStringVar(pointer(VArray[aArrayIndex]),tmp);
P.AsDateTime := Iso8601ToDateTime(tmp);
end else
P.AsDateTime := PDateTime(@VInt64)^;
SynCommons.ftUTF8:
SynTable.ftUTF8:
if aArrayIndex>=0 then
if (VArray[aArrayIndex]='') and
fConnection.Properties.StoreVoidStringAsNull then
@@ -627,7 +628,7 @@ procedure TSQLDBDatasetStatement.DataSetBindSQLParam(const aArrayIndex,
if fForceUseWideString then
P.Value := UTF8ToWideString(VData) else
P.AsString := UTF8ToString(VData);
SynCommons.ftBlob:
SynTable.ftBlob:
{$ifdef UNICODE}
if aArrayIndex>=0 then
P.SetBlobData(TValueBuffer(VArray[aArrayIndex]),Length(VArray[aArrayIndex])) else
@@ -654,17 +655,17 @@ procedure TSQLDBDatasetStatement.DataSetOutSQLParam(
begin
Par := fQueryParams[aParamIndex];
case aParam.VType of
SynCommons.ftInt64:
SynTable.ftInt64:
{$ifdef UNICODE}
aParam.VInt64 := Par.AsLargeInt;
{$else}
aParam.VInt64 := trunc(Par.AsFloat);
{$endif}
SynCommons.ftDouble: PDouble(@aParam.VInt64)^ := Par.AsFloat;
SynCommons.ftCurrency:PCurrency(@aParam.VInt64)^ := Par.AsCurrency;
SynCommons.ftDate: PDateTime(@aParam.VInt64)^ := Par.AsDateTime;
SynCommons.ftUTF8: aParam.VData := StringToUTF8(Par.AsString);
SynCommons.ftBlob: begin
SynTable.ftDouble: PDouble(@aParam.VInt64)^ := Par.AsFloat;
SynTable.ftCurrency:PCurrency(@aParam.VInt64)^ := Par.AsCurrency;
SynTable.ftDate: PDateTime(@aParam.VInt64)^ := Par.AsDateTime;
SynTable.ftUTF8: aParam.VData := StringToUTF8(Par.AsString);
SynTable.ftBlob: begin
{$ifdef UNICODE}
tmpBytes := Par.AsBlob;
SetString(aParam.VData,PAnsiChar(pointer(tmpBytes)),Length(tmpBytes));
@@ -69,6 +69,7 @@ interface
Classes,
Contnrs,
SynCommons,
SynTable,
SynDB,
DB,
DBCommon,
@@ -280,14 +281,14 @@ procedure TSynBinaryDataSet.InternalInitFieldDefs;
for F := 0 to fDataAccess.ColumnCount-1 do
with fDataAccess.Columns[F] do begin
case ColumnType of
SynCommons.ftInt64: DBType := ftLargeint;
SynCommons.ftDate: DBType := ftDateTime;
SynCommons.ftUTF8:
SynTable.ftInt64: DBType := ftLargeint;
SynTable.ftDate: DBType := ftDateTime;
SynTable.ftUTF8:
if ColumnDataSize=0 then
DBType := ftDefaultMemo else
DBType := ftWideString; // means UnicodeString for Delphi 2009+
SynCommons.ftBlob: DBType := ftBlob;
SynCommons.ftDouble, SynCommons.ftCurrency: DBType := ftFloat;
SynTable.ftBlob: DBType := ftBlob;
SynTable.ftDouble, SynTable.ftCurrency: DBType := ftFloat;
else raise EDatabaseError.CreateFmt(
'GetFieldData ColumnType=%s',[TSQLDBFieldTypeToString(ColumnType)]);
end;
@@ -306,15 +307,15 @@ function TSynBinaryDataSet.GetRowFieldData(Field: TField;
result := fDataAccess.ColumnData(F);
if (result<>nil) and not OnlyCheckNull then
case fDataAccess.Columns[F].ColumnType of
SynCommons.ftInt64: begin
SynTable.ftInt64: begin
fTemp64 := FromVarInt64(PByte(result));
result := @fTemp64;
end;
SynCommons.ftCurrency: begin // ftFloat expects a DOUBLE value
SynTable.ftCurrency: begin // ftFloat expects a DOUBLE value
PDouble(@fTemp64)^ := PCurrency(result)^;
result := @fTemp64;
end;
SynCommons.ftUTF8, SynCommons.ftBlob:
SynTable.ftUTF8, SynTable.ftBlob:
resultLen := FromVarUInt32(PByte(result));
end; // other ColumnTypes are already in the expected format
end;
@@ -69,6 +69,7 @@ interface
Variants,
{$endif}
SynCommons,
SynTable,
{$ifdef ISDELPHIXE2}
System.Generics.Collections,
Data.DB, Data.FMTBcd;
@@ -864,19 +865,19 @@ constructor TDocVariantArrayDataSet.Create(Owner: TComponent;
fColumns[ndx].Name := first^.Names[ndx];
fColumns[ndx].FieldType := VariantTypeToSQLDBFieldType(first^.Values[ndx]);
case fColumns[ndx].FieldType of
SynCommons.ftNull:
fColumns[ndx].FieldType := SynCommons.ftBlob;
SynCommons.ftCurrency:
fColumns[ndx].FieldType := SynCommons.ftDouble;
SynCommons.ftInt64: // ensure type coherency of whole column
SynTable.ftNull:
fColumns[ndx].FieldType := SynTable.ftBlob;
SynTable.ftCurrency:
fColumns[ndx].FieldType := SynTable.ftDouble;
SynTable.ftInt64: // ensure type coherency of whole column
for j := 1 to first^.Count-1 do
if j>=Length(fValues) then // check objects are consistent
break else
with _Safe(fValues[j],dvObject)^ do
if (ndx<Length(Names)) and IdemPropNameU(Names[ndx],fColumns[ndx].Name) then
if VariantTypeToSQLDBFieldType(Values[ndx]) in
[SynCommons.ftNull,SynCommons.ftDouble,SynCommons.ftCurrency] then begin
fColumns[ndx].FieldType := SynCommons.ftDouble;
[SynTable.ftNull,SynTable.ftDouble,SynTable.ftCurrency] then begin
fColumns[ndx].FieldType := SynTable.ftDouble;
break;
end;
end;
@@ -899,7 +900,7 @@ function TDocVariantArrayDataSet.GetRowFieldData(Field: TField;
F := Field.Index;
if (cardinal(RowIndex)<cardinal(length(fValues))) and
(cardinal(F)<cardinal(length(fColumns))) and
not (fColumns[F].FieldType in [ftNull,SynCommons.ftUnknown,SynCommons.ftCurrency]) then
not (fColumns[F].FieldType in [ftNull,SynTable.ftUnknown,SynTable.ftCurrency]) then
with _Safe(fValues[RowIndex])^ do
if (Kind=dvObject) and (Count>0) then begin
if IdemPropNameU(fColumns[F].Name,Names[F]) then
@@ -913,14 +914,14 @@ function TDocVariantArrayDataSet.GetRowFieldData(Field: TField;
case fColumns[F].FieldType of
ftInt64:
VariantToInt64(Values[ndx],fTemp64);
ftDouble,SynCommons.ftDate:
ftDouble,SynTable.ftDate:
VariantToDouble(Values[ndx],PDouble(@fTemp64)^);
ftUTF8: begin
VariantToUTF8(Values[ndx],fTempUTF8,wasString);
result := pointer(fTempUTF8);
ResultLen := length(fTempUTF8);
end;
SynCommons.ftBlob: begin
SynTable.ftBlob: begin
VariantToUTF8(Values[ndx],fTempUTF8,wasString);
if Base64MagicCheckAndDecode(pointer(fTempUTF8),length(fTempUTF8),fTempBlob) then begin
result := pointer(fTempBlob);
@@ -1 +1 @@
'1.18.4707'
'1.18.4708'

0 comments on commit dbc335e

Please sign in to comment.