Permalink
Browse files

fixed vtQWord proper support for FPC

- this doesn't exist in Delphi, but it should!
  • Loading branch information...
Arnaud Bouchez
Arnaud Bouchez committed Dec 1, 2017
1 parent 49f1030 commit 4e019e1b41f6759487e7479c194fcb28c25314c9
Showing with 52 additions and 12 deletions.
  1. +3 −0 CrossPlatform/SynCrossPlatformJSON.pas
  2. +5 −3 SyNode/SyNodeNewProto.pas
  3. +36 −5 SynCommons.pas
  4. +1 −1 SynCrtSock.pas
  5. +3 −0 SynDB.pas
  6. +2 −1 SynMongoDB.pas
  7. +1 −1 SynSM.pas
  8. +1 −1 SynopseCommit.inc
@@ -849,6 +849,9 @@ function VarRecToValue(const V: TVarRec; out wasString: boolean): string;
vtBoolean: if VBoolean then result := '1' else result := '0';
vtInteger: result := IntToStr(VInteger);
vtInt64: result := IntToStr(VInt64^);
{$ifdef FPC}
vtQWord: result := IntToStr(VQWord^);
{$endif}
vtCurrency: DoubleToJSON(VCurrency^,result);
vtExtended: DoubleToJSON(VExtended^,result);
vtObject: result := ObjectToJSON(VObject);
@@ -469,9 +469,9 @@ procedure VarRecToJSVal(cx: PJSContext; const V: TVarRec; var result: jsval);
case V.VType of
vtString: Result.asJSString := cx.NewJSString(RawUTF8(V.VString^));
vtAnsiString: Result.asJSString := cx.NewJSString(RawUTF8(V.VAnsiString)); // expect UTF-8 content
{$ifdef UNICODE}
{$ifdef UNICODE}
vtUnicodeString: Result.asJSString := cx.NewJSString(string(V.VUnicodeString));
{$endif}
{$endif}
vtWideString: Result.asJSString := cx.NewJSString(V.VWideString, length(WideString(V.VWideString)));
vtPChar: Result.asJSString := cx.NewJSString(string(V.VPChar));
vtChar: Result.asJSString := cx.NewJSString(string(V.VChar));
@@ -480,13 +480,15 @@ procedure VarRecToJSVal(cx: PJSContext; const V: TVarRec; var result: jsval);
vtBoolean: Result.AsBoolean := V.VBoolean;
vtInteger: Result.AsInteger := V.VInteger;
vtInt64: Result.AsInt64 := V.VInt64^;
{$ifdef FPC}
vtQWord: Result.AsInt64 := V.VQWord^;
{$endif}
vtCurrency: Result.AsDouble := V.VCurrency^;
vtExtended: Result.AsDouble := V.VExtended^;
vtObject: begin
New(inst);
Result := Inst.CreateForObj(cx, V.VObject, TSMNewRTTIProtoObject, Eng.GlobalObject);
end;

vtPointer: begin
if V.VPointer = nil then
Result.SetNull
@@ -20684,7 +20684,7 @@ function VarRecToInt64(const V: TVarRec; out value: Int64): boolean;
begin
case V.VType of
vtInteger: value := V.VInteger;
vtInt64: value := V.VInt64^;
vtInt64 {$ifdef FPC}, vtQWord{$endif}: value := V.VInt64^;
vtBoolean: if V.VBoolean then value := 1 else value := 0; // normalize
{$ifndef NOVARIANTS}
vtVariant: value := V.VVariant^;
@@ -20702,6 +20702,9 @@ function VarRecToDouble(const V: TVarRec; out value: double): boolean;
case V.VType of
vtInteger: value := V.VInteger;
vtInt64: value := V.VInt64^;
{$ifdef FPC}
vtQWord: value := V.VQWord^;
{$endif}
vtBoolean: if V.VBoolean then value := 1 else value := 0; // normalize
vtExtended: value := V.VExtended^;
vtCurrency: value := V.VCurrency^;
@@ -20720,6 +20723,7 @@ function VarRecToTempUTF8(const V: TVarRec; var tmpStr: RawUTF8; var Res: TTempU
{$ifndef NOVARIANTS}
var isString: boolean;
{$endif}
label smlu32;
begin
case V.VType of
vtString: begin
@@ -20783,7 +20787,7 @@ function VarRecToTempUTF8(const V: TVarRec; var tmpStr: RawUTF8; var Res: TTempU
vtInt64:
if (PCardinalArray(V.VInt64)^[0]<=high(SmallUInt32UTF8)) and
(PCardinalArray(V.VInt64)^[1]=0) then begin
Res.Text := pointer(SmallUInt32UTF8[PCardinalArray(V.VInt64)^[0]]);
smlu32: Res.Text := pointer(SmallUInt32UTF8[V.VInt64^]);
Res.Len := length(RawByteString(pointer(Res.Text)));
result := Res.Len;
exit;
@@ -20793,6 +20797,16 @@ function VarRecToTempUTF8(const V: TVarRec; var tmpStr: RawUTF8; var Res: TTempU
result := Res.Len;
exit;
end;
{$ifdef FPC}
vtQWord:
if (PCardinalArray(V.VQWord)^[0]<=high(SmallUInt32UTF8)) and
(PCardinalArray(V.VQWord)^[1]=0) then goto smlu32 else begin
Res.Text := PUTF8Char(StrUInt64(@Res.Temp[23],V.VQWord^));
Res.Len := @Res.Temp[23]-Res.Text;
result := Res.Len;
exit;
end;
{$endif}
vtCurrency: begin
Res.Text := @Res.Temp;
Res.Len := Curr64ToPChar(V.VInt64^,Res.Temp);
@@ -20844,7 +20858,8 @@ function VarRecToTempUTF8(const V: TVarRec; var tmpStr: RawUTF8; var Res: TTempU
procedure VarRecToUTF8(const V: TVarRec; var result: RawUTF8; wasString: PBoolean=nil);
var isString: boolean;
begin
isString := not (V.VType in [vtBoolean,vtInteger,vtInt64,vtCurrency,vtExtended]);
isString := not (V.VType in [
vtBoolean,vtInteger,vtInt64{$ifdef FPC},vtQWord{$endif},vtCurrency,vtExtended]);
with V do
case V.VType of
vtString:
@@ -20873,6 +20888,10 @@ procedure VarRecToUTF8(const V: TVarRec; var result: RawUTF8; wasString: PBoolea
Int32ToUtf8(VInteger,result);
vtInt64:
Int64ToUtf8(VInt64^,result);
{$ifdef FPC}
vtQWord:
UInt64ToUtf8(VQWord^,result);
{$endif}
vtCurrency:
Curr64ToStr(VInt64^,result);
vtExtended:
@@ -25253,8 +25272,8 @@ function FormatUTF8(const Format: RawUTF8; const Args, Params: array of const; J
F,FDeb: PUTF8Char;
wasString: Boolean;
const NOTTOQUOTE: array[boolean] of set of 0..31 = (
[vtBoolean,vtInteger,vtInt64,vtCurrency,vtExtended],
[vtBoolean,vtInteger,vtInt64,vtCurrency,vtExtended,vtVariant]);
[vtBoolean,vtInteger,vtInt64{$ifdef FPC},vtQWord{$endif},vtCurrency,vtExtended],
[vtBoolean,vtInteger,vtInt64{$ifdef FPC},vtQWord{$endif},vtCurrency,vtExtended,vtVariant]);
label Txt;
begin
if Format='' then begin
@@ -42892,6 +42911,12 @@ procedure VarRecToVariant(const V: TVarRec; var result: variant);
VType := varInt64;
VInt64 := V.VInt64^;
end;
{$ifdef FPC}
vtQWord: begin
VType := varQWord;
VQWord := V.VQWord^;
end;
{$endif}
vtCurrency: begin
VType := varCurrency;
VCurrency := V.VCurrency^;
@@ -51992,6 +52017,9 @@ procedure TTextWriter.AddJSONEscape(const V: TVarRec);
vtBoolean: Add(VBoolean); // 'true'/'false'
vtInteger: Add(VInteger);
vtInt64: Add(VInt64^);
{$ifdef FPC}
vtQWord: AddQ(V.VQWord^);
{$endif}
vtExtended: Add(VExtended^,DOUBLE_PRECISION);
vtCurrency: AddCurr64(VInt64^);
vtObject: WriteObject(VObject);
@@ -52018,6 +52046,9 @@ procedure TTextWriter.Add(const V: TVarRec; Escape: TTextWriterKind);
vtExtended: Add(VExtended^,DOUBLE_PRECISION);
vtCurrency: AddCurr64(VInt64^);
vtInt64: Add(VInt64^);
{$ifdef FPC}
vtQWord: AddQ(VQWord^);
{$endif}
{$ifndef NOVARIANTS}
vtVariant: AddVariant(VVariant^,Escape);
{$endif}
@@ -4391,7 +4391,7 @@ procedure TCrtSocket.SockSend(const Values: array of const);
Str(VInteger,tmp);
SockSend(@tmp[1],length(tmp));
end;
vtInt64: begin
vtInt64{$ifdef FPC},vtQWord{$endif}: begin
Str(VInt64^,tmp);
SockSend(@tmp[1],length(tmp));
end;
@@ -6639,6 +6639,9 @@ procedure TSQLDBStatement.Bind(const Params: array of const;
vtBoolean: Bind(i,integer(VBoolean),IO);
vtInteger: Bind(i,VInteger,IO);
vtInt64: Bind(i,VInt64^,IO);
{$ifdef FPC}
vtQWord: Bind(i,VQWord^,IO);
{$endif}
vtCurrency: BindCurrency(i,VCurrency^,IO);
vtExtended: Bind(i,VExtended^,IO);
vtPointer:
@@ -3505,10 +3505,11 @@ procedure TBSONWriter.BSONWrite(const name: RawUTF8; const value: TVarRec);
case value.VType of
vtBoolean: BSONWrite(name,value.VBoolean);
vtInteger: BSONWrite(name,value.VInteger);
vtInt64: BSONWrite(name,value.VInt64^);
vtCurrency: BSONWrite(name,value.VCurrency^);
vtExtended: BSONWrite(name,value.VExtended^);
vtVariant: BSONWriteVariant(name,value.VVariant^);
vtInt64{$ifdef FPC},vtQWord{$endif}:
BSONWrite(name,value.VInt64^);
vtString, vtAnsiString, {$ifdef HASVARUSTRING}vtUnicodeString,{$endif}
vtPChar, vtChar, vtWideChar, vtWideString: begin
VarRecToUTF8(value,tmp);
@@ -1700,7 +1700,7 @@ procedure TSMValue.SetTVarRec(cx: PJSContext; const V: TVarRec);
FValue := JSVAL_FALSE;
vtInteger:
FValue := INT_TO_JSVAL(V.VInteger);
vtInt64:
vtInt64{$ifdef FPC},vtQWord{$endif}:
SetInt64(V.VInt64^);
vtCurrency:
FValue := DOUBLE_TO_JSVAL(V.VCurrency^);
@@ -1 +1 @@
'1.18.4029'
'1.18.4030'

0 comments on commit 4e019e1

Please sign in to comment.