mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 00:39:34 +02:00
--- Merging r34818 into '.':
U packages/fcl-json/tests/testjsonrtti.pp --- Recording mergeinfo for merge of r34818 into '.': U . --- Merging r34819 into '.': U packages/fcl-json/tests/testjsondata.pp U packages/fcl-json/src/fpjson.pp --- Recording mergeinfo for merge of r34819 into '.': G . --- Merging r34851 into '.': U packages/pastojs/tests/tcconverter.pp U packages/pastojs/src/fppas2js.pp U packages/fcl-js/src/jsbase.pp U packages/fcl-js/src/jswriter.pp U packages/fcl-passrc/src/pasresolver.pp --- Recording mergeinfo for merge of r34851 into '.': G . --- Merging r34859 into '.': G packages/fcl-json/src/fpjson.pp --- Recording mergeinfo for merge of r34859 into '.': G . --- Merging r34860 into '.': G packages/fcl-json/tests/testjsonrtti.pp U packages/fcl-json/tests/testjson.lpi U packages/fcl-json/tests/testcomps.pp G packages/fcl-json/tests/testjsondata.pp --- Recording mergeinfo for merge of r34860 into '.': G . --- Merging r34869 into '.': U packages/fcl-json/src/jsonscanner.pp U packages/fcl-json/src/jsonparser.pp --- Recording mergeinfo for merge of r34869 into '.': G . --- Merging r34870 into '.': U packages/fcl-json/src/jsonconf.pp U packages/fcl-json/tests/jsonconftest.pp --- Recording mergeinfo for merge of r34870 into '.': G . --- Merging r34875 into '.': U packages/fcl-web/src/base/fphttpclient.pp A packages/fcl-web/examples/httpclient/keepalive.pp A packages/fcl-web/examples/httpclient/keepalive.lpi --- Recording mergeinfo for merge of r34875 into '.': G . --- Merging r35022 into '.': U packages/rtl-extra/src/unix/clocale.pp U packages/pastojs/tests/tcmodules.pas G packages/pastojs/src/fppas2js.pp G packages/fcl-js/src/jswriter.pp U packages/fcl-js/src/jstree.pp --- Recording mergeinfo for merge of r35022 into '.': G . --- Merging r35023 into '.': G packages/pastojs/tests/tcmodules.pas G packages/pastojs/src/fppas2js.pp G packages/fcl-js/src/jswriter.pp G packages/fcl-js/src/jstree.pp G packages/rtl-extra/src/unix/clocale.pp --- Recording mergeinfo for merge of r35023 into '.': G . --- Merging r35055 into '.': G packages/fcl-js/src/jswriter.pp U packages/fcl-js/src/jstree.pp G packages/pastojs/src/fppas2js.pp U packages/pastojs/tests/tcmodules.pas --- Recording mergeinfo for merge of r35055 into '.': G . --- Merging r35121 into '.': U packages/fpgtk/src/fpgtkext.pp U packages/fpmkunit/src/fpmkunit.pp U packages/fcl-web/src/base/iniwebsession.pp U packages/winunits-base/src/commctrl.pp U packages/winunits-base/src/dwmapi.pp U packages/winunits-jedi/src/jwawinwlx.pas U packages/winunits-jedi/src/jwawinbase.pas U packages/winunits-jedi/src/jwaimagehlp.pas U packages/winunits-jedi/src/jwawinioctl.pas --- Recording mergeinfo for merge of r35121 into '.': G . --- Merging r35166 into '.': U packages/fcl-js/tests/tcscanner.pp U packages/fcl-js/tests/tcparser.pp U packages/fcl-js/tests/tcwriter.pp U packages/fcl-js/src/jsscanner.pp U packages/fcl-js/src/jsparser.pp G packages/fcl-js/src/jswriter.pp U packages/fcl-passrc/src/pastree.pp G packages/fcl-passrc/src/pasresolver.pp U packages/fcl-passrc/tests/tcresolver.pas G packages/pastojs/tests/tcmodules.pas --- Recording mergeinfo for merge of r35166 into '.': G . # revisions: 34818,34819,34851,34859,34860,34869,34870,34875,35022,35023,35055,35121,35166 git-svn-id: branches/fixes_3_0@35980 -
This commit is contained in:
marco
parent
9fb4239994
commit
cc2ed51356
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -3075,6 +3075,8 @@ packages/fcl-web/examples/httpclient/httppost.lpi svneol=native#text/plain
|
||||
packages/fcl-web/examples/httpclient/httppost.pp svneol=native#text/plain
|
||||
packages/fcl-web/examples/httpclient/httppostfile.lpi svneol=native#text/plain
|
||||
packages/fcl-web/examples/httpclient/httppostfile.pp svneol=native#text/plain
|
||||
packages/fcl-web/examples/httpclient/keepalive.lpi svneol=native#text/plain
|
||||
packages/fcl-web/examples/httpclient/keepalive.pp svneol=native#text/plain
|
||||
packages/fcl-web/examples/httpserver/simplehttpserver.lpi svneol=native#text/plain
|
||||
packages/fcl-web/examples/httpserver/simplehttpserver.pas svneol=native#text/plain
|
||||
packages/fcl-web/examples/jsonrpc/demo1/README.txt svneol=native#text/plain
|
||||
|
||||
@ -25,7 +25,7 @@ uses
|
||||
Type
|
||||
TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,JSTCompletion);
|
||||
|
||||
TJSString = WideString;
|
||||
TJSString = UnicodeString;
|
||||
TJSNumber = Double;
|
||||
|
||||
{ TJSValue }
|
||||
@ -39,6 +39,7 @@ Type
|
||||
1 : (F : TJSNumber);
|
||||
2 : (I : Integer);
|
||||
end;
|
||||
FCustomValue: TJSString;
|
||||
procedure ClearValue(ANewValue: TJSType);
|
||||
function GetAsBoolean: Boolean;
|
||||
function GetAsCompletion: TObject;
|
||||
@ -64,6 +65,7 @@ Type
|
||||
Constructor Create(AString: TJSString);
|
||||
Destructor Destroy; override;
|
||||
Property ValueType : TJSType Read FValueType;
|
||||
Property CustomValue: TJSString Read FCustomValue Write FCustomValue;
|
||||
Property IsUndefined : Boolean Read GetIsUndefined Write SetIsUndefined;
|
||||
Property IsNull : Boolean Read GetIsNull Write SetIsNull;
|
||||
Property AsNumber : TJSNumber Read GetAsNumber Write SetAsNumber;
|
||||
@ -144,6 +146,7 @@ begin
|
||||
FValue.I:=0;
|
||||
end;
|
||||
FValueType:=ANewValue;
|
||||
FCustomValue:='';
|
||||
end;
|
||||
|
||||
procedure TJSValue.SetAsBoolean(const AValue: Boolean);
|
||||
@ -184,40 +187,46 @@ end;
|
||||
|
||||
procedure TJSValue.SetIsNull(const AValue: Boolean);
|
||||
begin
|
||||
ClearValue(jstNull);
|
||||
if AValue then
|
||||
ClearValue(jstNull)
|
||||
else if IsNull then
|
||||
ClearValue(jstUNDEFINED);
|
||||
end;
|
||||
|
||||
procedure TJSValue.SetIsUndefined(const AValue: Boolean);
|
||||
begin
|
||||
ClearValue(jstUndefined);
|
||||
if AValue then
|
||||
ClearValue(jstUndefined)
|
||||
else if IsUndefined then
|
||||
ClearValue(jstNull);
|
||||
end;
|
||||
|
||||
Constructor TJSValue.CreateNull;
|
||||
constructor TJSValue.CreateNull;
|
||||
begin
|
||||
IsNull:=True;
|
||||
end;
|
||||
|
||||
Constructor TJSValue.Create;
|
||||
constructor TJSValue.Create;
|
||||
begin
|
||||
IsUndefined:=True;
|
||||
end;
|
||||
|
||||
Constructor TJSValue.Create(ANumber: TJSNumber);
|
||||
constructor TJSValue.Create(ANumber: TJSNumber);
|
||||
begin
|
||||
AsNumber:=ANumber;
|
||||
end;
|
||||
|
||||
Constructor TJSValue.Create(ABoolean: Boolean);
|
||||
constructor TJSValue.Create(ABoolean: Boolean);
|
||||
begin
|
||||
AsBoolean:=ABoolean;
|
||||
end;
|
||||
|
||||
Constructor TJSValue.Create(AString: TJSString);
|
||||
constructor TJSValue.Create(AString: TJSString);
|
||||
begin
|
||||
AsString:=AString;
|
||||
end;
|
||||
|
||||
Destructor TJSValue.Destroy;
|
||||
destructor TJSValue.Destroy;
|
||||
begin
|
||||
ClearValue(jstUndefined);
|
||||
inherited Destroy;
|
||||
|
||||
@ -153,7 +153,7 @@ Resourcestring
|
||||
SErrCatchFinallyExpected = 'Unexpected token: Expected ''catch'' or ''finally''';
|
||||
SErrArgumentsExpected = 'Unexpected token: Expected '','' or '')'', got %s';
|
||||
SErrArrayEnd = 'Unexpected token: Expected '','' or '']'', got %s';
|
||||
SErrObjectEnd = 'Unexpected token: Expected '','' or ''}'', got %s';
|
||||
//SErrObjectEnd = 'Unexpected token: Expected '','' or ''}'', got %s';
|
||||
SErrObjectElement = 'Unexpected token: Expected string, identifier or number after '','' got: %s';
|
||||
SErrLiteralExpected = 'Unexpected token: Expected: null, true, false, number, string, or regex, got: %s';
|
||||
SErrInvalidnumber = 'Invalid numerical value: %s';
|
||||
@ -188,6 +188,7 @@ begin
|
||||
FCurrent:=FScanner.FetchToken;
|
||||
FCurrentString:=FScanner.CurTokenString;
|
||||
end;
|
||||
Result:=FCurrent;
|
||||
{$ifdef debugparser}Writeln('GetNextToken (',FScanner.CurLine,',',FScanner.CurColumn,'): ',GetEnumName(TypeInfo(TJSToken),Ord(FCurrent)), ' As string: ',FCurrentString);{$endif debugparser}
|
||||
end;
|
||||
|
||||
@ -1816,6 +1817,7 @@ begin
|
||||
end
|
||||
else
|
||||
n:='';
|
||||
if n='' then ; // what to do with that?
|
||||
Consume(tjsBraceOpen);
|
||||
F.AFunction:= TJSFuncDef.Create;
|
||||
Args:=ParseFormalParameterList;
|
||||
|
||||
@ -79,7 +79,6 @@ Type
|
||||
FCurToken: TJSToken;
|
||||
FCurTokenString: string;
|
||||
FCurLine: string;
|
||||
FDefines: TStrings;
|
||||
TokenStr: PChar;
|
||||
FWasEndOfLine : Boolean;
|
||||
FSourceStream : TStream;
|
||||
@ -377,7 +376,7 @@ function TJSScanner.DoStringLiteral: TJSToken;
|
||||
Var
|
||||
Delim : Char;
|
||||
TokenStart : PChar;
|
||||
Len,OLen,I : Integer;
|
||||
Len,OLen: Integer;
|
||||
S : String;
|
||||
|
||||
begin
|
||||
@ -522,12 +521,6 @@ end;
|
||||
|
||||
Function TJSScanner.FetchToken: TJSToken;
|
||||
|
||||
|
||||
var
|
||||
TokenStart, CurPos: PChar;
|
||||
i: TJSToken;
|
||||
OldLength, SectionLength, NestingLevel, Index: Integer;
|
||||
|
||||
begin
|
||||
if not (FCurtoken in [tjsWhiteSpace,tjsComment]) then
|
||||
FWasEndOfLine:=False;
|
||||
@ -541,7 +534,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
CurPos:=TokenStr;
|
||||
//CurPos:=TokenStr;
|
||||
FCurTokenString := '';
|
||||
case TokenStr[0] of
|
||||
#0: // Empty line
|
||||
|
||||
@ -883,7 +883,7 @@ Type
|
||||
Destructor Destroy; override;
|
||||
Property Cond : TJSelement Read FCond Write FCond;
|
||||
Property Cases : TJSCaseElements Read FCases;
|
||||
Property TheDefault : TJSCaseelement Read FDefault Write FDefault; // one of Cases
|
||||
Property TheDefault : TJSCaseElement Read FDefault Write FDefault; // one of Cases
|
||||
end;
|
||||
|
||||
{ TJSLabeledStatement - e.g. 'TheLabel : A' }
|
||||
|
||||
@ -136,7 +136,7 @@ Type
|
||||
Procedure WriteIfStatement(El: TJSIfStatement);virtual;
|
||||
Procedure WriteSourceElements(El: TJSSourceElements);virtual;
|
||||
Procedure WriteStatementList(El: TJSStatementList);virtual;
|
||||
Procedure WriteTryStatement(el: TJSTryStatement);virtual;
|
||||
Procedure WriteTryStatement(El: TJSTryStatement);virtual;
|
||||
Procedure WriteVarDeclaration(El: TJSVarDeclaration);virtual;
|
||||
Procedure WriteWithStatement(El: TJSWithStatement);virtual;
|
||||
Procedure WriteVarDeclarationList(El: TJSVariableDeclarationList);virtual;
|
||||
@ -144,7 +144,7 @@ Type
|
||||
Procedure WriteFunctionBody(El: TJSFunctionBody);virtual;
|
||||
Procedure WriteFunctionDeclarationStatement(El: TJSFunctionDeclarationStatement);virtual;
|
||||
Procedure WriteLabeledStatement(El: TJSLabeledStatement);virtual;
|
||||
Procedure WriteReturnStatement(EL: TJSReturnStatement);virtual;
|
||||
Procedure WriteReturnStatement(El: TJSReturnStatement);virtual;
|
||||
Procedure WriteTargetStatement(El: TJSTargetStatement);virtual;
|
||||
Procedure WriteFuncDef(FD: TJSFuncDef);virtual;
|
||||
Procedure WritePrimaryExpression(El: TJSPrimaryExpression);virtual;
|
||||
@ -222,6 +222,7 @@ Var
|
||||
|
||||
begin
|
||||
Result:=Length(S)*SizeOf(Char);
|
||||
if Result=0 then exit;
|
||||
MinLen:=Result+FBufPos;
|
||||
If (MinLen>Capacity) then
|
||||
begin
|
||||
@ -241,6 +242,7 @@ Var
|
||||
|
||||
begin
|
||||
Result:=Length(S)*SizeOf(UnicodeChar);
|
||||
if Result=0 then exit;
|
||||
MinLen:=Result+FBufPos;
|
||||
If (MinLen>Capacity) then
|
||||
begin
|
||||
@ -425,20 +427,23 @@ procedure TJSWriter.WriteValue(V: TJSValue);
|
||||
Var
|
||||
S : String;
|
||||
begin
|
||||
Case V.ValueType of
|
||||
jstUNDEFINED : S:='undefined';
|
||||
jstNull : s:='null';
|
||||
jstBoolean : if V.AsBoolean then s:='true' else s:='false';
|
||||
jstString : S:='"'+EscapeString(V.AsString)+'"';
|
||||
jstNumber :
|
||||
if Frac(V.AsNumber)=0 then // this needs to be improved
|
||||
Str(Round(V.AsNumber),S)
|
||||
else
|
||||
Str(V.AsNumber,S);
|
||||
jstObject : ;
|
||||
jstReference : ;
|
||||
JSTCompletion : ;
|
||||
end;
|
||||
if V.CustomValue<>'' then
|
||||
S:=JSStringToStr(V.CustomValue)
|
||||
else
|
||||
Case V.ValueType of
|
||||
jstUNDEFINED : S:='undefined';
|
||||
jstNull : s:='null';
|
||||
jstBoolean : if V.AsBoolean then s:='true' else s:='false';
|
||||
jstString : S:='"'+EscapeString(V.AsString)+'"';
|
||||
jstNumber :
|
||||
if Frac(V.AsNumber)=0 then // this needs to be improved
|
||||
Str(Round(V.AsNumber),S)
|
||||
else
|
||||
Str(V.AsNumber,S);
|
||||
jstObject : ;
|
||||
jstReference : ;
|
||||
JSTCompletion : ;
|
||||
end;
|
||||
Write(S);
|
||||
end;
|
||||
|
||||
@ -560,45 +565,46 @@ end;
|
||||
|
||||
procedure TJSWriter.WriteArrayLiteral(El: TJSArrayLiteral);
|
||||
|
||||
|
||||
|
||||
Var
|
||||
Chars : Array[Boolean] of string[2] = ('[]','()');
|
||||
|
||||
Var
|
||||
i,C : Integer;
|
||||
isArgs,WC : Boolean;
|
||||
isArgs,WC , MultiLine: Boolean;
|
||||
BC : String[2];
|
||||
|
||||
begin
|
||||
isArgs:=el is TJSArguments;
|
||||
isArgs:=El is TJSArguments;
|
||||
BC:=Chars[isArgs];
|
||||
C:=EL.Elements.Count-1;
|
||||
C:=El.Elements.Count-1;
|
||||
if C=-1 then
|
||||
begin
|
||||
if isArgs then
|
||||
Write(bc)
|
||||
else
|
||||
Write(bc);
|
||||
Write(bc);
|
||||
Exit;
|
||||
end;
|
||||
WC:=(woCompact in Options) or
|
||||
((Not isArgs) and (woCompactArrayLiterals in Options)) or
|
||||
(isArgs and (woCompactArguments in Options)) ;
|
||||
if WC then
|
||||
Write(Copy(BC,1,1))
|
||||
else
|
||||
MultiLine:=(not WC) and (C>4);
|
||||
if MultiLine then
|
||||
begin
|
||||
Writeln(Copy(BC,1,1));
|
||||
Indent;
|
||||
end;
|
||||
end
|
||||
else
|
||||
Write(Copy(BC,1,1));
|
||||
For I:=0 to C do
|
||||
begin
|
||||
WriteJS(EL.Elements[i].Expr);
|
||||
if I<C then
|
||||
if WC then Write(', ') else Writeln(',')
|
||||
end;
|
||||
if not WC then
|
||||
begin
|
||||
WriteJS(El.Elements[i].Expr);
|
||||
if I<C then
|
||||
if WC then
|
||||
Write(',')
|
||||
else if MultiLine then
|
||||
Writeln(',')
|
||||
else
|
||||
Write(', ');
|
||||
end;
|
||||
if MultiLine then
|
||||
begin
|
||||
Writeln('');
|
||||
Undent;
|
||||
@ -682,7 +688,7 @@ procedure TJSWriter.WriteCallExpression(El: TJSCallExpression);
|
||||
begin
|
||||
WriteJS(El.Expr);
|
||||
if Assigned(El.Args) then
|
||||
WriteArrayLiteral(EL.Args)
|
||||
WriteArrayLiteral(El.Args)
|
||||
else
|
||||
Write('()');
|
||||
end;
|
||||
@ -818,7 +824,7 @@ begin
|
||||
WriteJS(EL.LHS);
|
||||
S:=El.OperatorString;
|
||||
If Not (woCompact in Options) then
|
||||
S:=' '+S+' ';
|
||||
S:=' '+S+' ';
|
||||
Write(s);
|
||||
WriteJS(EL.Expr);
|
||||
end;
|
||||
@ -838,11 +844,16 @@ procedure TJSWriter.WriteIfStatement(El: TJSIfStatement);
|
||||
|
||||
begin
|
||||
Write('if (');
|
||||
WriteJS(EL.Cond);
|
||||
Write(') ');
|
||||
WriteJS(El.BTrue);
|
||||
WriteJS(El.Cond);
|
||||
Write(')');
|
||||
If Not (woCompact in Options) then
|
||||
Write(' ');
|
||||
if (El.BTrue<>nil) and (not (El.BTrue is TJSEmptyStatement)) then
|
||||
WriteJS(El.BTrue);
|
||||
if Assigned(El.BFalse) then
|
||||
begin
|
||||
if (El.BTrue=nil) or (El.BTrue is TJSEmptyStatement) then
|
||||
Write('{}');
|
||||
Write(' else ');
|
||||
WriteJS(El.BFalse)
|
||||
end;
|
||||
@ -926,15 +937,15 @@ begin
|
||||
C:=(woCompact in Options);
|
||||
Write('switch (');
|
||||
If Assigned(El.Cond) then
|
||||
WriteJS(EL.Cond);
|
||||
WriteJS(El.Cond);
|
||||
if C then
|
||||
Write(') {')
|
||||
else
|
||||
Writeln(') {');
|
||||
For I:=0 to EL.Cases.Count-1 do
|
||||
For I:=0 to El.Cases.Count-1 do
|
||||
begin
|
||||
EC:=EL.Cases[i];
|
||||
if EC=EL.TheDefault then
|
||||
EC:=El.Cases[i];
|
||||
if EC=El.TheDefault then
|
||||
Write('default')
|
||||
else
|
||||
begin
|
||||
@ -947,14 +958,22 @@ begin
|
||||
Writeln(':');
|
||||
if Assigned(EC.Body) then
|
||||
begin
|
||||
FSkipBrackets:=true;
|
||||
Indent;
|
||||
WriteJS(EC.Body);
|
||||
Undent;
|
||||
if Not ((EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement)) then
|
||||
if C then
|
||||
Write('; ')
|
||||
else
|
||||
Writeln(';');
|
||||
end
|
||||
else
|
||||
begin
|
||||
if C then
|
||||
begin
|
||||
if Not ((EC.Body is TJSStatementList) or (EC.Body is TJSEmptyBlockStatement)) then
|
||||
write('; ')
|
||||
end
|
||||
Write('; ')
|
||||
else
|
||||
Writeln('');
|
||||
Writeln(';');
|
||||
end;
|
||||
end;
|
||||
Write('}');
|
||||
@ -993,11 +1012,16 @@ begin
|
||||
Error('Unknown target statement class: "%s"',[EL.ClassName])
|
||||
end;
|
||||
|
||||
procedure TJSWriter.WriteReturnStatement(EL: TJSReturnStatement);
|
||||
procedure TJSWriter.WriteReturnStatement(El: TJSReturnStatement);
|
||||
|
||||
begin
|
||||
Write('return ');
|
||||
WriteJS(EL.Expr);
|
||||
if El.Expr=nil then
|
||||
Write('return')
|
||||
else
|
||||
begin
|
||||
Write('return ');
|
||||
WriteJS(El.Expr);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJSWriter.WriteLabeledStatement(El: TJSLabeledStatement);
|
||||
@ -1014,7 +1038,7 @@ begin
|
||||
WriteJS(EL.A);
|
||||
end;
|
||||
|
||||
procedure TJSWriter.WriteTryStatement(el: TJSTryStatement);
|
||||
procedure TJSWriter.WriteTryStatement(El: TJSTryStatement);
|
||||
|
||||
Var
|
||||
C : Boolean;
|
||||
@ -1031,7 +1055,6 @@ begin
|
||||
Write('} ')
|
||||
else
|
||||
begin
|
||||
Writeln('');
|
||||
Writeln('}');
|
||||
end;
|
||||
If (El is TJSTryCatchFinallyStatement) or (El is TJSTryCatchStatement) then
|
||||
@ -1042,7 +1065,7 @@ begin
|
||||
else
|
||||
Writeln(') {');
|
||||
Indent;
|
||||
WriteJS(EL.BCatch);
|
||||
WriteJS(El.BCatch);
|
||||
Undent;
|
||||
If C then
|
||||
if (El is TJSTryCatchFinallyStatement) then
|
||||
@ -1062,15 +1085,10 @@ begin
|
||||
else
|
||||
Writeln('finally {');
|
||||
Indent;
|
||||
WriteJS(EL.BFinally);
|
||||
FSkipBrackets:=True;
|
||||
WriteJS(El.BFinally);
|
||||
Undent;
|
||||
If C then
|
||||
Write('}')
|
||||
else
|
||||
begin
|
||||
Writeln('');
|
||||
Writeln('}');
|
||||
end;
|
||||
Write('}');
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -5,7 +5,7 @@ unit tcparser;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry, jsParser, jstree, jsbase;
|
||||
Classes, SysUtils, fpcunit, testregistry, jsParser, jstree, jsbase;
|
||||
|
||||
type
|
||||
|
||||
@ -172,9 +172,6 @@ Function TTestJSParser.GetFirstStatement: TJSElement;
|
||||
|
||||
Var
|
||||
E : TJSElementNodes;
|
||||
N : TJSElement;
|
||||
X : TJSExpressionStatement;
|
||||
|
||||
begin
|
||||
E:=GetStatements;
|
||||
AssertNotNull('Have statements',E);
|
||||
@ -186,8 +183,6 @@ end;
|
||||
Function TTestJSParser.GetFirstVar: TJSElement;
|
||||
Var
|
||||
E : TJSElementNodes;
|
||||
N : TJSElement;
|
||||
X : TJSExpressionStatement;
|
||||
begin
|
||||
E:=GetVars;
|
||||
AssertNotNull('Have statements',E);
|
||||
@ -202,8 +197,6 @@ Function TTestJSParser.GetExpressionStatement: TJSExpressionStatement;
|
||||
|
||||
Var
|
||||
N : TJSElement;
|
||||
X : TJSExpressionStatement;
|
||||
|
||||
begin
|
||||
N:=GetFirstStatement;
|
||||
CheckClass(N,TJSExpressionStatement);
|
||||
@ -2247,8 +2240,6 @@ procedure TTestJSParser.TestSwitchEmpty;
|
||||
Var
|
||||
E : TJSElement;
|
||||
S : TJSSwitchStatement;
|
||||
P : TJSPrimaryExpressionIdent;
|
||||
|
||||
begin
|
||||
CreateParser('switch (a) {}');
|
||||
E:=GetFirstStatement;
|
||||
@ -2265,7 +2256,6 @@ procedure TTestJSParser.TestSwitchOne;
|
||||
Var
|
||||
E : TJSElement;
|
||||
S : TJSSwitchStatement;
|
||||
P : TJSPrimaryExpressionIdent;
|
||||
C : TJSCaseElement;
|
||||
begin
|
||||
CreateParser('switch (a) { case c : {}}');
|
||||
@ -2286,7 +2276,6 @@ procedure TTestJSParser.TestSwitchTwo;
|
||||
Var
|
||||
E : TJSElement;
|
||||
S : TJSSwitchStatement;
|
||||
P : TJSPrimaryExpressionIdent;
|
||||
C : TJSCaseElement;
|
||||
begin
|
||||
CreateParser('switch (a) { case c: {}'+sLineBreak+' case d: {}}');
|
||||
@ -2310,7 +2299,6 @@ procedure TTestJSParser.TestSwitchTwoDefault;
|
||||
Var
|
||||
E : TJSElement;
|
||||
S : TJSSwitchStatement;
|
||||
P : TJSPrimaryExpressionIdent;
|
||||
C : TJSCaseElement;
|
||||
begin
|
||||
CreateParser('switch (a) { case c: {} case d: {} default: {}}');
|
||||
|
||||
@ -5,7 +5,7 @@ unit tcscanner;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Typinfo, fpcunit, testutils, testregistry, jstoken, jsscanner;
|
||||
Classes, SysUtils, Typinfo, fpcunit, testregistry, jstoken, jsscanner;
|
||||
|
||||
type
|
||||
|
||||
@ -190,7 +190,6 @@ end;
|
||||
procedure TTestJSScanner.AssertEquals(AMessage : String; AExpected, AActual: TJSToken);
|
||||
|
||||
Var
|
||||
J : TJSToken;
|
||||
S,EN1,EN2 : String;
|
||||
|
||||
begin
|
||||
@ -857,7 +856,6 @@ procedure TTestJSScanner.DoTestString(S: String);
|
||||
|
||||
Var
|
||||
J : TJSToken;
|
||||
T : String;
|
||||
begin
|
||||
CreateScanner(S);
|
||||
try
|
||||
|
||||
@ -2430,7 +2430,6 @@ end;
|
||||
|
||||
|
||||
Initialization
|
||||
|
||||
RegisterTests([TTestTestJSWriter,TTestLiteralWriter,TTestExpressionWriter,TTestStatementWriter]);
|
||||
end.
|
||||
|
||||
|
||||
@ -283,6 +283,8 @@ Type
|
||||
function GetAsJSON: TJSONStringType; override;
|
||||
function GetAsString: TJSONStringType; override;
|
||||
procedure SetAsString(const AValue: TJSONStringType); override;
|
||||
Public
|
||||
Class var StrictEscaping : Boolean;
|
||||
public
|
||||
Constructor Create(const AValue : TJSONStringType); reintroduce;
|
||||
Constructor Create(const AValue : TJSONUnicodeStringType); reintroduce;
|
||||
@ -588,7 +590,7 @@ Type
|
||||
Function SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass) : TJSONDataClass;
|
||||
Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
|
||||
|
||||
Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
|
||||
Function StringToJSONString(const S : TJSONStringType; Strict : Boolean = False) : TJSONStringType;
|
||||
Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
|
||||
Function JSONTypeName(JSONType : TJSONType) : String;
|
||||
|
||||
@ -599,10 +601,10 @@ Function CreateJSON(Data : Integer) : TJSONIntegerNumber;
|
||||
Function CreateJSON(Data : Int64) : TJSONInt64Number;
|
||||
Function CreateJSON(Data : QWord) : TJSONQWordNumber;
|
||||
Function CreateJSON(Data : TJSONFloat) : TJSONFloatNumber;
|
||||
Function CreateJSON(Data : TJSONStringType) : TJSONString;
|
||||
Function CreateJSON(Data : TJSONUnicodeStringType) : TJSONString;
|
||||
Function CreateJSONArray(Data : Array of const) : TJSONArray;
|
||||
Function CreateJSONObject(Data : Array of const) : TJSONObject;
|
||||
Function CreateJSON(const Data : TJSONStringType) : TJSONString;
|
||||
Function CreateJSON(const Data : TJSONUnicodeStringType) : TJSONString;
|
||||
Function CreateJSONArray(const Data : Array of const) : TJSONArray;
|
||||
Function CreateJSONObject(const Data : Array of const) : TJSONObject;
|
||||
|
||||
// These functions rely on a callback. If the callback is not set, they will raise an error.
|
||||
// When the jsonparser unit is included in the project, the callback is automatically set.
|
||||
@ -662,7 +664,7 @@ begin
|
||||
Result:=DefaultJSONInstanceTypes[AType]
|
||||
end;
|
||||
|
||||
function StringToJSONString(const S: TJSONStringType): TJSONStringType;
|
||||
function StringToJSONString(const S: TJSONStringType; Strict : Boolean = False): TJSONStringType;
|
||||
|
||||
Var
|
||||
I,J,L : Integer;
|
||||
@ -683,7 +685,10 @@ begin
|
||||
Result:=Result+Copy(S,J,I-J);
|
||||
Case C of
|
||||
'\' : Result:=Result+'\\';
|
||||
'/' : Result:=Result+'\/';
|
||||
'/' : if Strict then
|
||||
Result:=Result+'\/'
|
||||
else
|
||||
Result:=Result+'/';
|
||||
'"' : Result:=Result+'\"';
|
||||
#8 : Result:=Result+'\b';
|
||||
#9 : Result:=Result+'\t';
|
||||
@ -782,31 +787,30 @@ begin
|
||||
Result:=TJSONFloatNumberCLass(DefaultJSONInstanceTypes[jitNumberFloat]).Create(Data);
|
||||
end;
|
||||
|
||||
function CreateJSON(Data: TJSONStringType): TJSONString;
|
||||
function CreateJSON(const Data: TJSONStringType): TJSONString;
|
||||
begin
|
||||
Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
|
||||
end;
|
||||
|
||||
function CreateJSON(Data: TJSONUnicodeStringType): TJSONString;
|
||||
function CreateJSON(const Data: TJSONUnicodeStringType): TJSONString;
|
||||
begin
|
||||
Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
|
||||
end;
|
||||
|
||||
function CreateJSONArray(Data: array of const): TJSONArray;
|
||||
function CreateJSONArray(const Data: array of const): TJSONArray;
|
||||
begin
|
||||
Result:=TJSONArrayCLass(DefaultJSONInstanceTypes[jitArray]).Create(Data);
|
||||
end;
|
||||
|
||||
function CreateJSONObject(Data: array of const): TJSONObject;
|
||||
function CreateJSONObject(const Data: array of const): TJSONObject;
|
||||
begin
|
||||
Result:=TJSONObjectCLass(DefaultJSONInstanceTypes[jitObject]).Create(Data);
|
||||
Result:=TJSONObjectClass(DefaultJSONInstanceTypes[jitObject]).Create(Data);
|
||||
end;
|
||||
|
||||
Var
|
||||
JPH : TJSONParserHandler;
|
||||
|
||||
function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean
|
||||
): TJSONData;
|
||||
function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean): TJSONData;
|
||||
|
||||
Var
|
||||
SS : TStringStream;
|
||||
@ -1087,7 +1091,7 @@ begin
|
||||
if (I>0) then
|
||||
W(',');
|
||||
W('"');
|
||||
W(StringToJSONString(O.Names[i]));
|
||||
W(StringToJSONString(O.Names[i],False));
|
||||
W('":');
|
||||
O.Items[I].DumpJSON(S);
|
||||
end;
|
||||
@ -1304,7 +1308,7 @@ end;
|
||||
|
||||
function TJSONString.GetAsJSON: TJSONStringType;
|
||||
begin
|
||||
Result:='"'+StringToJSONString(FValue)+'"';
|
||||
Result:='"'+StringToJSONString(FValue,StrictEscaping)+'"';
|
||||
end;
|
||||
|
||||
function TJSONString.GetAsString: TJSONStringType;
|
||||
|
||||
@ -637,6 +637,7 @@ begin
|
||||
Node.Delete(L);
|
||||
end;
|
||||
end;
|
||||
FModified:=True;
|
||||
end;
|
||||
|
||||
procedure TJSONConfig.DeleteValue(const APath: UnicodeString);
|
||||
|
||||
@ -29,7 +29,7 @@ Type
|
||||
Private
|
||||
FScanner : TJSONScanner;
|
||||
function GetO(AIndex: TJSONOption): Boolean;
|
||||
function GetOptions: TJSONOptions;
|
||||
function GetOptions: TJSONOptions; inline;
|
||||
function ParseNumber: TJSONNumber;
|
||||
procedure SetO(AIndex: TJSONOption; AValue: Boolean);
|
||||
procedure SetOptions(AValue: TJSONOptions);
|
||||
@ -38,7 +38,7 @@ Type
|
||||
function DoParse(AtCurrent,AllowEOF: Boolean): TJSONData;
|
||||
function GetNextToken: TJSONToken;
|
||||
function CurrentTokenString: String;
|
||||
function CurrentToken: TJSONToken;
|
||||
function CurrentToken: TJSONToken; inline;
|
||||
function ParseArray: TJSONArray;
|
||||
function ParseObject: TJSONObject;
|
||||
Property Scanner : TJSONScanner read FScanner;
|
||||
|
||||
@ -69,13 +69,13 @@ Type
|
||||
FCurLine: string;
|
||||
TokenStr: PChar;
|
||||
FOptions : TJSONOptions;
|
||||
function GetCurColumn: Integer;
|
||||
function GetCurColumn: Integer; inline;
|
||||
function GetO(AIndex: TJSONOption): Boolean;
|
||||
procedure SetO(AIndex: TJSONOption; AValue: Boolean);
|
||||
protected
|
||||
procedure Error(const Msg: string);overload;
|
||||
procedure Error(const Msg: string; Const Args: array of Const);overload;
|
||||
function DoFetchToken: TJSONToken;
|
||||
function DoFetchToken: TJSONToken; inline;
|
||||
public
|
||||
constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
|
||||
constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
|
||||
|
||||
@ -179,7 +179,9 @@ begin
|
||||
C:=CreateConf('test.json');
|
||||
try
|
||||
C.SetValue('a',1);
|
||||
C.Flush;
|
||||
C.DeleteValue('a');
|
||||
AssertEquals('Modified set',True,C.Modified);
|
||||
AssertEquals('Delete value',0,C.GetValue('a',0));
|
||||
C.SetValue('b/a',1);
|
||||
C.SetValue('b/c',2);
|
||||
@ -187,7 +189,9 @@ begin
|
||||
AssertEquals('Delete value in subkey',0,C.GetValue('a',0));
|
||||
AssertEquals('Delete value only clears deleted value',2,C.GetValue('b/c',0));
|
||||
C.SetValue('b/a',1);
|
||||
C.Flush;
|
||||
C.DeletePath('b');
|
||||
AssertEquals('Modified set',True,C.Modified);
|
||||
AssertEquals('Delete path',0,C.GetValue('b/a',0));
|
||||
AssertEquals('Delete path deletes all values',0,C.GetValue('b/c',0));
|
||||
C.Clear;
|
||||
|
||||
@ -191,7 +191,7 @@ Type
|
||||
Public
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
Published
|
||||
Property ExtendedProp : Comp Read F Write F;
|
||||
Property CompProp : Comp Read F Write F;
|
||||
end;
|
||||
|
||||
// Currency property
|
||||
|
||||
@ -25,7 +25,7 @@
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<CommandLineParams Value="--suite=TTestJSONDeStreamer.TestDateTimeFormat"/>
|
||||
<CommandLineParams Value="--suite=TTestParser.TestObjectError"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
|
||||
@ -36,7 +36,7 @@ type
|
||||
|
||||
TTestJSONString = Class(TTestCase)
|
||||
Private
|
||||
Procedure TestTo(Const Src,Dest : String);
|
||||
Procedure TestTo(Const Src,Dest : String; Strict : Boolean = False);
|
||||
Procedure TestFrom(Const Src,Dest : String);
|
||||
Published
|
||||
Procedure TestJSONStringToString;
|
||||
@ -147,6 +147,7 @@ type
|
||||
published
|
||||
procedure TestString;
|
||||
procedure TestControlString;
|
||||
procedure TestSolidus;
|
||||
procedure TestInteger;
|
||||
procedure TestNegativeInteger;
|
||||
procedure TestFloat;
|
||||
@ -1501,7 +1502,6 @@ Var
|
||||
T : String;
|
||||
|
||||
begin
|
||||
|
||||
J:=TJSONString.Create('');
|
||||
try
|
||||
For I:=0 to 31 do
|
||||
@ -1523,6 +1523,23 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestString.TestSolidus;
|
||||
Var
|
||||
J : TJSONString;
|
||||
|
||||
begin
|
||||
J:=TJSONString.Create('');
|
||||
try
|
||||
J.AsString:='http://www.json.org/';
|
||||
TJSONString.StrictEscaping:=True;
|
||||
TestJSON(J,'"http:\/\/www.json.org\/"');
|
||||
TJSONString.StrictEscaping:=False;
|
||||
TestJSON(J,'"http://www.json.org/"');
|
||||
finally
|
||||
FreeAndNil(J);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestString.TestInteger;
|
||||
|
||||
Const
|
||||
@ -1567,7 +1584,7 @@ begin
|
||||
TestAsBoolean(J,True,False);
|
||||
TestAsInteger(J,-1,False);
|
||||
TestAsInt64(J,-1,False);
|
||||
TestAsQWord(J,-1,True);
|
||||
TestAsQWord(J,QWord(-1),True);
|
||||
TestAsString(J,S);
|
||||
TestAsFloat(J,-1.0,False);
|
||||
finally
|
||||
@ -1612,7 +1629,7 @@ begin
|
||||
TestAsBoolean(J,True,False);
|
||||
TestAsInteger(J,-1,True);
|
||||
TestAsInt64(J,-1,True);
|
||||
TestAsQWord(J,-1,True);
|
||||
TestAsQWord(J,QWord(-1),True);
|
||||
TestAsString(J,S);
|
||||
TestAsFloat(J,-1.0,True);
|
||||
finally
|
||||
@ -4026,14 +4043,14 @@ end;
|
||||
|
||||
{ TTestJSONString }
|
||||
|
||||
procedure TTestJSONString.TestTo(const Src, Dest: String);
|
||||
procedure TTestJSONString.TestTo(const Src, Dest: String; Strict : Boolean = False);
|
||||
|
||||
Var
|
||||
S : String;
|
||||
|
||||
begin
|
||||
S:='StringToJSONString('''+Src+''')='''+Dest+'''';
|
||||
AssertEquals(S,Dest,StringToJSONString(Src));
|
||||
AssertEquals(S,Dest,StringToJSONString(Src,Strict));
|
||||
end;
|
||||
|
||||
procedure TTestJSONString.TestFrom(const Src, Dest: String);
|
||||
@ -4092,7 +4109,8 @@ begin
|
||||
TestTo('AB','AB');
|
||||
TestTo('ABC','ABC');
|
||||
TestTo('\','\\');
|
||||
TestTo('/','\/');
|
||||
TestTo('/','/');
|
||||
TestTo('/','\/',True);
|
||||
TestTo('"','\"');
|
||||
TestTo(#8,'\b');
|
||||
TestTo(#9,'\t');
|
||||
@ -4115,7 +4133,8 @@ begin
|
||||
TestTo('A'#12'BC','A\fBC');
|
||||
TestTo('A'#13'BC','A\rBC');
|
||||
TestTo('\\','\\\\');
|
||||
TestTo('//','\/\/');
|
||||
TestTo('//','//');
|
||||
TestTo('//','\/\/',true);
|
||||
TestTo('""','\"\"');
|
||||
TestTo(#8#8,'\b\b');
|
||||
TestTo(#9#9,'\t\t');
|
||||
|
||||
@ -5,7 +5,7 @@ unit testjsonrtti;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry, typinfo, fpjson,
|
||||
Classes, SysUtils, fpcunit, testregistry, typinfo, fpjson,
|
||||
dateutils, testcomps, testjsondata, fpjsonrtti;
|
||||
|
||||
type
|
||||
@ -366,12 +366,8 @@ Var
|
||||
|
||||
begin
|
||||
B:=TCompComponent.Create(Nil);
|
||||
DeStream('{ "ExtendedProp" : 5.67 }',B);
|
||||
{$ifdef CPUX86_64}
|
||||
AssertEquals('Correct comp value',round(5.67),B.ExtendedProp);
|
||||
{$else}
|
||||
AssertEquals('Correct extended value',5.67,B.ExtendedProp);
|
||||
{$endif}
|
||||
DeStream('{ "CompProp" : 5.67 }',B);
|
||||
AssertEquals('Correct comp value',round(5.67),B.CompProp);
|
||||
end;
|
||||
|
||||
procedure TTestJSONDeStreamer.TestFloat5;
|
||||
@ -876,12 +872,7 @@ procedure TTestJSONStreamer.TestWriteFloat4;
|
||||
begin
|
||||
StreamObject(TCompComponent.Create(Nil));
|
||||
AssertPropCount(1);
|
||||
// Extended is correct, propname is wrong
|
||||
{$ifdef CPUX86_64}
|
||||
AssertProp('ExtendedProp',TJSONFloat(5));
|
||||
{$else}
|
||||
AssertProp('ExtendedProp',4.56);
|
||||
{$endif}
|
||||
AssertProp('CompProp',5);
|
||||
end;
|
||||
|
||||
procedure TTestJSONStreamer.TestWriteFloat5;
|
||||
|
||||
@ -91,10 +91,10 @@
|
||||
- arrays TPasArrayType
|
||||
- check if var initexpr fits vartype: var a: type = expr;
|
||||
- built-in functions high, low for range type and arrays
|
||||
|
||||
ToDo:
|
||||
- procedure type
|
||||
- method type
|
||||
|
||||
ToDo:
|
||||
- char constant #0, #10, #13, UTF-8 char
|
||||
- const TArrayValues
|
||||
- classes - TPasClassType
|
||||
@ -276,6 +276,7 @@ type
|
||||
btVariant, // variant
|
||||
btNil, // nil = pointer, class, procedure, method, ...
|
||||
btProc, // TPasProcedure
|
||||
btBuiltInProc,
|
||||
btSet,
|
||||
btRange
|
||||
);
|
||||
@ -363,13 +364,15 @@ const
|
||||
'Text',
|
||||
'Variant',
|
||||
'Nil',
|
||||
'PasProcedure',
|
||||
'Procedure/Function',
|
||||
'BuiltInProc',
|
||||
'[set]',
|
||||
'..range..'
|
||||
);
|
||||
|
||||
type
|
||||
TResolverBuiltInProc = (
|
||||
bfCustom,
|
||||
bfLength,
|
||||
bfSetLength,
|
||||
bfInclude,
|
||||
@ -385,6 +388,7 @@ type
|
||||
TResolverBuiltInProcs = set of TResolverBuiltInProc;
|
||||
const
|
||||
ResolverBuiltInProcNames: array[TResolverBuiltInProc] of shortstring = (
|
||||
'Custom',
|
||||
'Length',
|
||||
'SetLength',
|
||||
'Include',
|
||||
@ -397,7 +401,7 @@ const
|
||||
'Low',
|
||||
'High'
|
||||
);
|
||||
bfAllStandardProcs = [low(TResolverBuiltInProc)..high(TResolverBuiltInProc)];
|
||||
bfAllStandardProcs = [Succ(bfCustom)..high(TResolverBuiltInProc)];
|
||||
|
||||
const
|
||||
ResolverResultVar = 'Result';
|
||||
@ -705,8 +709,9 @@ type
|
||||
end;
|
||||
|
||||
TResolvedReferenceFlag = (
|
||||
rrfVMT, // use VMT for call
|
||||
rrfNewInstance // constructor call
|
||||
rrfCallWithoutParams, // a TPrimitiveExpr is a call without params
|
||||
rrfNewInstance, // constructor call (without it call a constructor as normal method)
|
||||
rrfVMT // use VMT for call
|
||||
);
|
||||
TResolvedReferenceFlags = set of TResolvedReferenceFlag;
|
||||
|
||||
@ -766,12 +771,13 @@ type
|
||||
TOnGetCallResult = procedure(Proc: TResElDataBuiltInProc; Params: TParamsExpr;
|
||||
out ResolvedEl: TPasResolverResult) of object;
|
||||
|
||||
{ TResElDataBuiltInProc - CustomData for compiler built-in procs like 'length' }
|
||||
{ TResElDataBuiltInProc - TPasUnresolvedSymbolRef(aType).CustomData for compiler built-in procs like 'length' }
|
||||
|
||||
TResElDataBuiltInProc = Class(TResElDataBuiltInSymbol)
|
||||
public
|
||||
Proc: TPasUnresolvedSymbolRef;
|
||||
Signature: string;
|
||||
BuiltIn: TResolverBuiltInProc;
|
||||
GetCallCompatibility: TOnGetCallCompatibility;
|
||||
GetCallResult: TOnGetCallResult;
|
||||
end;
|
||||
@ -869,6 +875,7 @@ type
|
||||
procedure ResolveImplForLoop(Loop: TPasImplForLoop);
|
||||
procedure ResolveImplWithDo(El: TPasImplWithDo);
|
||||
procedure ResolveImplAssign(El: TPasImplAssign);
|
||||
procedure ResolveImplSimple(El: TPasImplSimple);
|
||||
procedure ResolveImplRaise(El: TPasImplRaise);
|
||||
procedure ResolveExpr(El: TPasExpr);
|
||||
procedure ResolveBooleanExpr(El: TPasExpr);
|
||||
@ -982,7 +989,8 @@ type
|
||||
function IsBaseType(aType: TPasType; BaseType: TResolverBaseType): boolean;
|
||||
function AddBuiltInProc(aName: shortstring; Signature: string;
|
||||
const GetCallCompatibility: TOnGetCallCompatibility;
|
||||
const GetCallResult: TOnGetCallResult): TResElDataBuiltInProc;
|
||||
const GetCallResult: TOnGetCallResult;
|
||||
BuiltIn: TResolverBuiltInProc = bfCustom): TResElDataBuiltInProc;
|
||||
// add extra TResolveData (E.CustomData) to free list
|
||||
procedure AddResolveData(El: TPasElement; Data: TResolveData;
|
||||
Kind: TResolveDataListKind);
|
||||
@ -2054,7 +2062,7 @@ begin
|
||||
Item:=FindLocalIdentifier(aName);
|
||||
while Item<>nil do
|
||||
begin
|
||||
writeln('TPasIdentifierScope.IterateElements ',ClassName,' ',Item.Identifier,' ',GetObjName(Item.Element));
|
||||
//writeln('TPasIdentifierScope.IterateElements ',ClassName,' ',Item.Identifier,' ',GetObjName(Item.Element));
|
||||
{$IFDEF VerbosePasResolver}
|
||||
OldElement:=Item.Element;
|
||||
{$ENDIF}
|
||||
@ -3387,7 +3395,7 @@ begin
|
||||
else if El.ClassType=TPasImplAssign then
|
||||
ResolveImplAssign(TPasImplAssign(El))
|
||||
else if El.ClassType=TPasImplSimple then
|
||||
ResolveExpr(TPasImplSimple(El).expr)
|
||||
ResolveImplSimple(TPasImplSimple(El))
|
||||
else if El.ClassType=TPasImplBlock then
|
||||
ResolveImplBlock(TPasImplBlock(El))
|
||||
else if El.ClassType=TPasImplRepeatUntil then
|
||||
@ -3587,7 +3595,10 @@ begin
|
||||
ComputeElement(El.right,RightResolved,[rcSkipTypeAlias]);
|
||||
|
||||
if RightResolved.BaseType=btProc then
|
||||
begin
|
||||
// ToDo: Delphi also uses left side to decide whether use function reference or function result
|
||||
ComputeProcWithoutParams(RightResolved,El.right);
|
||||
end;
|
||||
|
||||
case El.Kind of
|
||||
akDefault:
|
||||
@ -3638,6 +3649,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.ResolveImplSimple(El: TPasImplSimple);
|
||||
var
|
||||
ExprResolved: TPasResolverResult;
|
||||
begin
|
||||
ResolveExpr(El.expr);
|
||||
ComputeElement(El.expr,ExprResolved,[rcSkipTypeAlias,rcReturnFuncResult]);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.ResolveImplRaise(El: TPasImplRaise);
|
||||
var
|
||||
ResolvedEl: TPasResolverResult;
|
||||
@ -3713,14 +3732,15 @@ begin
|
||||
DeclEl:=FindElementWithoutParams(aName,FindData,El,false);
|
||||
if DeclEl is TPasProcedure then
|
||||
begin
|
||||
// identifier is a call and args brackets are missing
|
||||
// identifier is a proc and args brackets are missing
|
||||
if El.Parent.ClassType=TPasProperty then
|
||||
// a property accessor does not need args -> ok
|
||||
else
|
||||
begin
|
||||
// examples: funca or @proca or a.funca or @a.funca ...
|
||||
Proc:=TPasProcedure(DeclEl);
|
||||
if (Proc.ProcType.Args.Count>0)
|
||||
and (TPasArgument(Proc.ProcType.Args[0]).ValueExpr=nil)
|
||||
and (TPasArgument(Proc.ProcType.Args[0]).ValueExpr=nil) // no default value -> param needed
|
||||
and not ExprIsAddrTarget(El)
|
||||
then
|
||||
RaiseMsg(nWrongNumberOfParametersForCallTo,
|
||||
@ -4604,10 +4624,19 @@ procedure TPasResolver.ComputeBinaryExpr(Bin: TBinaryExpr; out
|
||||
var
|
||||
LeftResolved, RightResolved: TPasResolverResult;
|
||||
begin
|
||||
if (Bin.OpCode=eopSubIdent)
|
||||
or ((Bin.OpCode=eopNone) and (Bin.left is TInheritedExpr)) then
|
||||
begin
|
||||
ComputeElement(Bin.right,ResolvedEl,Flags);
|
||||
exit;
|
||||
end;
|
||||
|
||||
ComputeElement(Bin.left,LeftResolved,Flags);
|
||||
ComputeElement(Bin.right,RightResolved,Flags);
|
||||
// ToDo: check operator overloading
|
||||
|
||||
//writeln('TPasResolver.ComputeBinaryExpr ',OpcodeStrings[Bin.OpCode],' Left=',GetResolverResultDesc(LeftResolved),' Right=',GetResolverResultDesc(RightResolved));
|
||||
|
||||
if LeftResolved.BaseType=btProc then
|
||||
ComputeProcWithoutParams(LeftResolved,Bin.left);
|
||||
if RightResolved.BaseType=btProc then
|
||||
@ -5181,7 +5210,7 @@ var
|
||||
Proc: TPasProcedure;
|
||||
begin
|
||||
if ExprIsAddrTarget(Expr) then exit;
|
||||
// call without arguments
|
||||
|
||||
if ResolvedEl.IdentEl=nil then
|
||||
RaiseNotYetImplemented(20160928183455,Expr,GetResolverResultDesc(ResolvedEl));
|
||||
if not (ResolvedEl.IdentEl is TPasProcedure) then
|
||||
@ -5191,6 +5220,9 @@ begin
|
||||
and (TPasArgument(Proc.ProcType.Args[0]).ValueExpr=nil) then
|
||||
RaiseMsg(nWrongNumberOfParametersForCallTo,sWrongNumberOfParametersForCallTo,
|
||||
[GetProcDesc(Proc.ProcType)],Expr);
|
||||
|
||||
if Expr.CustomData is TResolvedReference then
|
||||
Include(TResolvedReference(Expr.CustomData).Flags,rrfCallWithoutParams);
|
||||
if (ResolvedEl.IdentEl is TPasFunction) then
|
||||
ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,ResolvedEl,[])
|
||||
else if ResolvedEl.IdentEl.ClassType=TPasConstructor then
|
||||
@ -5199,7 +5231,7 @@ begin
|
||||
SetResolverValueExpr(ResolvedEl,btContext,aClass,Expr,[rrfReadable]);
|
||||
end
|
||||
else
|
||||
RaiseXExpectedButYFound('function',ResolvedEl.IdentEl.ElementTypeName,Expr);
|
||||
; // simple procedure call -> keep ResolvedEl as btProc
|
||||
end;
|
||||
|
||||
procedure TPasResolver.CheckIsClass(El: TPasElement;
|
||||
@ -6214,37 +6246,37 @@ begin
|
||||
AddBaseType(BaseTypeNames[bt],bt);
|
||||
if bfLength in BaseProcs then
|
||||
AddBuiltInProc('Length','function Length(const String or Array): sizeint',
|
||||
@OnGetCallCompatibility_Length,@OnGetCallResult_Length);
|
||||
@OnGetCallCompatibility_Length,@OnGetCallResult_Length,bfLength);
|
||||
if bfSetLength in BaseProcs then
|
||||
AddBuiltInProc('SetLength','procedure SetLength(var String or Array; NewLength: sizeint)',
|
||||
@OnGetCallCompatibility_SetLength,nil);
|
||||
@OnGetCallCompatibility_SetLength,nil,bfSetLength);
|
||||
if bfInclude in BaseProcs then
|
||||
AddBuiltInProc('Include','procedure Include(var Set of Enum; const Enum)',
|
||||
@OnGetCallCompatibility_InExclude,nil);
|
||||
@OnGetCallCompatibility_InExclude,nil,bfInclude);
|
||||
if bfExclude in BaseProcs then
|
||||
AddBuiltInProc('Exclude','procedure Exclude(var Set of Enum; const Enum)',
|
||||
@OnGetCallCompatibility_InExclude,nil);
|
||||
@OnGetCallCompatibility_InExclude,nil,bfExclude);
|
||||
if bfOrd in BaseProcs then
|
||||
AddBuiltInProc('Ord','function Ord(const Enum or Char): integer',
|
||||
@OnGetCallCompatibility_Ord,@OnGetCallResult_Ord);
|
||||
@OnGetCallCompatibility_Ord,@OnGetCallResult_Ord,bfOrd);
|
||||
if bfExit in BaseProcs then
|
||||
AddBuiltInProc('Exit','procedure Exit(result)',
|
||||
@OnGetCallCompatibility_Exit,nil);
|
||||
@OnGetCallCompatibility_Exit,nil,bfExit);
|
||||
if bfInc in BaseProcs then
|
||||
AddBuiltInProc('Inc','procedure Inc(var Integer; const Incr: Integer = 1)',
|
||||
@OnGetCallCompatibility_IncDec,nil);
|
||||
@OnGetCallCompatibility_IncDec,nil,bfInc);
|
||||
if bfDec in BaseProcs then
|
||||
AddBuiltInProc('Dec','procedure Dec(var Integer; const Decr: Integer = 1)',
|
||||
@OnGetCallCompatibility_IncDec,nil);
|
||||
@OnGetCallCompatibility_IncDec,nil,bfDec);
|
||||
if bfAssigned in BaseProcs then
|
||||
AddBuiltInProc('Assigned','function Assigned(const Pointer or Class or Class-of): boolean',
|
||||
@OnGetCallCompatibility_Assigned,@OnGetCallResult_Assigned);
|
||||
@OnGetCallCompatibility_Assigned,@OnGetCallResult_Assigned,bfAssigned);
|
||||
if bfLow in BaseProcs then
|
||||
AddBuiltInProc('Low','function Low(const array or ordinal): ordinal or integer',
|
||||
@OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh);
|
||||
@OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh,bfLow);
|
||||
if bfHigh in BaseProcs then
|
||||
AddBuiltInProc('High','function High(const array or ordinal): ordinal or integer',
|
||||
@OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh);
|
||||
@OnGetCallCompatibility_LowHigh,@OnGetCallResult_LowHigh,bfHigh);
|
||||
end;
|
||||
|
||||
function TPasResolver.AddBaseType(aName: shortstring; Typ: TResolverBaseType
|
||||
@ -6272,7 +6304,8 @@ end;
|
||||
|
||||
function TPasResolver.AddBuiltInProc(aName: shortstring; Signature: string;
|
||||
const GetCallCompatibility: TOnGetCallCompatibility;
|
||||
const GetCallResult: TOnGetCallResult): TResElDataBuiltInProc;
|
||||
const GetCallResult: TOnGetCallResult; BuiltIn: TResolverBuiltInProc
|
||||
): TResElDataBuiltInProc;
|
||||
var
|
||||
El: TPasUnresolvedSymbolRef;
|
||||
begin
|
||||
@ -6280,6 +6313,7 @@ begin
|
||||
Result:=TResElDataBuiltInProc.Create;
|
||||
Result.Proc:=El;
|
||||
Result.Signature:=Signature;
|
||||
Result.BuiltIn:=BuiltIn;
|
||||
Result.GetCallCompatibility:=GetCallCompatibility;
|
||||
Result.GetCallResult:=GetCallResult;
|
||||
AddResolveData(El,Result,lkBuiltIn);
|
||||
@ -7576,6 +7610,7 @@ begin
|
||||
begin
|
||||
if rcConstant in Flags then
|
||||
RaiseConstantExprExp(El);
|
||||
Include(TResolvedReference(El.CustomData).Flags,rrfCallWithoutParams);
|
||||
if ResolvedEl.IdentEl is TPasFunction then
|
||||
// function => return result
|
||||
ComputeElement(TPasFunction(ResolvedEl.IdentEl).FuncType.ResultEl,ResolvedEl,Flags-[rcReturnFuncResult])
|
||||
@ -7618,7 +7653,7 @@ begin
|
||||
SetResolverIdentifier(ResolvedEl,TResElDataBaseType(El.CustomData).BaseType,
|
||||
El,TPasUnresolvedSymbolRef(El),[])
|
||||
else if El.CustomData is TResElDataBuiltInProc then
|
||||
RaiseInternalError(20161003174747) // should have been computed in El.ClassType=TParamsExpr
|
||||
SetResolverIdentifier(ResolvedEl,btBuiltInProc,El,TPasUnresolvedSymbolRef(El),[])
|
||||
else
|
||||
RaiseNotYetImplemented(20160926194756,El);
|
||||
end
|
||||
@ -7804,6 +7839,18 @@ begin
|
||||
SetResolverIdentifier(ResolvedEl,btContext,El,TPasProcedureType(El),[])
|
||||
else if El.ClassType=TPasArrayType then
|
||||
SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),[])
|
||||
else if El.ClassType=TInheritedExpr then
|
||||
begin
|
||||
if El.CustomData is TResolvedReference then
|
||||
begin
|
||||
DeclEl:=TResolvedReference(El.CustomData).Declaration as TPasProcedure;
|
||||
SetResolverIdentifier(ResolvedEl,btProc,DeclEl,
|
||||
TPasProcedure(DeclEl).ProcType,[]);
|
||||
end
|
||||
else
|
||||
// no ancestor proc
|
||||
SetResolverIdentifier(ResolvedEl,btBuiltInProc,nil,nil,[]);
|
||||
end
|
||||
else
|
||||
RaiseNotYetImplemented(20160922163705,El);
|
||||
end;
|
||||
@ -7849,7 +7896,7 @@ begin
|
||||
end;
|
||||
|
||||
function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean;
|
||||
// returns true of El is the last element of an @ operator expression
|
||||
// returns true if El is the last element of an @ operator expression
|
||||
// e.g. the OnClick in '@p().o[].OnClick'
|
||||
// or '@s[]'
|
||||
var
|
||||
|
||||
@ -622,7 +622,7 @@ type
|
||||
public
|
||||
Access: TArgumentAccess;
|
||||
ArgType: TPasType;
|
||||
ValueExpr: TPasExpr;
|
||||
ValueExpr: TPasExpr; // the default value
|
||||
Function Value : String;
|
||||
end;
|
||||
|
||||
|
||||
@ -2762,7 +2762,7 @@ begin
|
||||
Add('var {#i}i: longint;');
|
||||
Add('begin');
|
||||
Add(' {@i}i:={@P}P();');
|
||||
CheckResolverException('function expected, but procedure found',PasResolver.nXExpectedButYFound);
|
||||
CheckResolverException('{Incompatible types: got "Procedure/Function" expected "Longint"',PasResolver.nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestFunctionResultInCondition;
|
||||
@ -4769,9 +4769,6 @@ begin
|
||||
Add(' ff:=@GetNumberFunc;');
|
||||
Add(' ff:=GetNumberFuncFunc; // not in Delphi');
|
||||
Add(' ff:=GetNumberFuncFunc();');
|
||||
Add(' // forbidden: f:=GetNumberFuncFunc;');
|
||||
Add(' // forbidden: f:=GetNumberFuncFunc();');
|
||||
Add(' // fpc crash: f:=GetNumberFuncFunc()();');
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
|
||||
60
packages/fcl-web/examples/httpclient/keepalive.lpi
Normal file
60
packages/fcl-web/examples/httpclient/keepalive.lpi
Normal file
@ -0,0 +1,60 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<UseDefaultCompilerOptions Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="keepalive"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="keepalive.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="keepalive"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
125
packages/fcl-web/examples/httpclient/keepalive.pp
Normal file
125
packages/fcl-web/examples/httpclient/keepalive.pp
Normal file
@ -0,0 +1,125 @@
|
||||
program keepalive;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, CustApp, fphttpclient;
|
||||
|
||||
const
|
||||
URL_DIRECT = 'https://www.google.com/humans.txt';
|
||||
URL_REDIRECTED = 'https://google.com/humans.txt';
|
||||
|
||||
type
|
||||
|
||||
{ TKeepConnectionDemo }
|
||||
|
||||
TKeepConnectionDemo = class(TCustomApplication)
|
||||
private
|
||||
FURL : String;
|
||||
FShowResult : Boolean;
|
||||
FCount : Integer;
|
||||
FHttp: TFPHTTPClient;
|
||||
FData: TBytesStream;
|
||||
procedure DoRequests;
|
||||
procedure Usage(Msg: string);
|
||||
Protected
|
||||
Procedure DoRun; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
|
||||
constructor TKeepConnectionDemo.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
StopOnException:=True;
|
||||
FHttp := TFPHTTPClient.Create(nil);
|
||||
FData := TBytesStream.Create;
|
||||
end;
|
||||
|
||||
destructor TKeepConnectionDemo.Destroy;
|
||||
begin
|
||||
FData.Free;
|
||||
FHttp.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
procedure TKeepConnectionDemo.DoRequests;
|
||||
var
|
||||
U: string;
|
||||
B, E: TDateTime;
|
||||
L : TStrings;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
for I:=1 to FCount do
|
||||
begin
|
||||
FData.Clear;
|
||||
B := Now;
|
||||
if (FURL<>'') then
|
||||
U:=FURL
|
||||
else if FHTTP.AllowRedirect then
|
||||
U := URL_REDIRECTED
|
||||
else
|
||||
U := URL_DIRECT;
|
||||
FHttp.Get(U, FData);
|
||||
E := Now;
|
||||
Writeln('Request ',i,', Duration: ',FormatDateTime('hh:nn:ss.zzz', E - B));
|
||||
If FShowResult then
|
||||
begin
|
||||
FData.Seek(0, TSeekOrigin.soBeginning);
|
||||
With TStringList.Create do
|
||||
try
|
||||
LoadFromStream(FData);
|
||||
Writeln(text);
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TKeepConnectionDemo.Usage(Msg : string);
|
||||
|
||||
begin
|
||||
if (Msg<>'') then
|
||||
Writeln('Error : ',Msg);
|
||||
Writeln(' Usage : keepalive [options]');
|
||||
Writeln('Where options is one or more of:');
|
||||
Writeln('-h --help This help');
|
||||
Writeln('-r --redirect Allow HTTP Redirect');
|
||||
Writeln('-k --keep-connection Keep connection');
|
||||
Writeln('-c --count=N Number of requests');
|
||||
Writeln('-u --URL=uri Specify url');
|
||||
Halt(Ord(Msg<>''));
|
||||
end;
|
||||
procedure TKeepConnectionDemo.DoRun;
|
||||
|
||||
Var
|
||||
S : String;
|
||||
|
||||
begin
|
||||
S:=CheckOptions('hrksc:u:',['count:','show','url:','redirect','keep-connection','help']);
|
||||
if (S<>'') or HasOption('h','help') then
|
||||
Usage(S);
|
||||
FCount:=StrToIntDef(GetOptionValue('c','count'),10);
|
||||
FShowResult:=HasOption('s','show');
|
||||
FURL:=GetOptionValue('u','url');
|
||||
FHTTP.AllowRedirect:=HasOption('r','redirect');
|
||||
FHTTP.KeepConnection:=HasOption('k','keep-connection');
|
||||
DoRequests;
|
||||
Terminate;
|
||||
end;
|
||||
|
||||
begin
|
||||
With TKeepConnectionDemo.Create(Nil) do
|
||||
try
|
||||
Initialize;
|
||||
Run;
|
||||
Finally
|
||||
Free;
|
||||
end;
|
||||
end.
|
||||
|
||||
@ -70,6 +70,7 @@ Type
|
||||
FDataRead : Int64;
|
||||
FContentLength : Int64;
|
||||
FAllowRedirect: Boolean;
|
||||
FKeepConnection: Boolean;
|
||||
FMaxRedirects: Byte;
|
||||
FOnDataReceived: TDataEvent;
|
||||
FOnHeaders: TNotifyEvent;
|
||||
@ -97,11 +98,26 @@ Type
|
||||
function GetProxy: TProxyData;
|
||||
Procedure ResetResponse;
|
||||
Procedure SetCookies(const AValue: TStrings);
|
||||
procedure SetHTTPVersion(const AValue: String);
|
||||
procedure SetKeepConnection(AValue: Boolean);
|
||||
procedure SetProxy(AValue: TProxyData);
|
||||
Procedure SetRequestHeaders(const AValue: TStrings);
|
||||
procedure SetIOTimeout(AValue: Integer);
|
||||
Procedure ExtractHostPort(AURI: TURI; Out AHost: String; Out APort: Word);
|
||||
Procedure CheckConnectionCloseHeader;
|
||||
protected
|
||||
|
||||
Function NoContentAllowed(ACode : Integer) : Boolean;
|
||||
// Peform a request, close connection.
|
||||
Procedure DoNormalRequest(const AURI: TURI; const AMethod: string;
|
||||
AStream: TStream; const AAllowedResponseCodes: array of Integer;
|
||||
AHeadersOnly, AIsHttps: Boolean); virtual;
|
||||
// Peform a request, try to keep connection.
|
||||
Procedure DoKeepConnectionRequest(const AURI: TURI; const AMethod: string;
|
||||
AStream: TStream; const AAllowedResponseCodes: array of Integer;
|
||||
AHeadersOnly, AIsHttps: Boolean); virtual;
|
||||
// Return True if FSocket is assigned
|
||||
Function IsConnected: Boolean; virtual;
|
||||
// True if we need to use a proxy: ProxyData Assigned and Hostname Set
|
||||
Function ProxyActive : Boolean;
|
||||
// Override this if you want to create a custom instance of proxy.
|
||||
@ -113,19 +129,23 @@ Type
|
||||
// Construct server URL for use in request line.
|
||||
function GetServerURL(URI: TURI): String;
|
||||
// Read 1 line of response. Fills FBuffer
|
||||
function ReadString: String;
|
||||
function ReadString(out S: String): Boolean;
|
||||
// Check if response code is in AllowedResponseCodes. if not, an exception is raised.
|
||||
// If AllowRedirect is true, and the result is a Redirect status code, the result is also true
|
||||
// If the OnPassword event is set, then a 401 will also result in True.
|
||||
function CheckResponseCode(ACode: Integer; const AllowedResponseCodes: array of Integer): Boolean; virtual;
|
||||
// Read response from server, and write any document to Stream.
|
||||
Procedure ReadResponse(Stream: TStream; const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False); virtual;
|
||||
Function ReadResponse(Stream: TStream; const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False): Boolean; virtual;
|
||||
// Read server response line and headers. Returns status code.
|
||||
Function ReadResponseHeaders : integer; virtual;
|
||||
// Allow header in request ? (currently checks only if non-empty and contains : token)
|
||||
function AllowHeader(var AHeader: String): Boolean; virtual;
|
||||
// Return True if the "connection: close" header is present
|
||||
Function HasConnectionClose: Boolean; virtual;
|
||||
// Connect to the server. Must initialize FSocket.
|
||||
Procedure ConnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
|
||||
// Re-connect to the server. Must reinitialize FSocket.
|
||||
Procedure ReconnectToServer(const AHost: String; APort: Integer; UseSSL : Boolean=False); virtual;
|
||||
// Disconnect from server. Must free FSocket.
|
||||
Procedure DisconnectFromServer; virtual;
|
||||
// Run method AMethod, using request URL AURL. Write Response to Stream, and headers in ResponseHeaders.
|
||||
@ -152,7 +172,7 @@ Type
|
||||
// Add header, replacing an existing one if it exists.
|
||||
Procedure AddHeader(Const AHeader,AValue : String);
|
||||
// Return header value, empty if not present.
|
||||
Function GetHeader(Const AHeader : String) : String;
|
||||
Function GetHeader(Const AHeader : String) : String;
|
||||
// General-purpose call. Handles redirect and authorization retry (OnPassword).
|
||||
Procedure HTTPMethod(Const AMethod,AURL : String; Stream : TStream; Const AllowedResponseCodes : Array of Integer); virtual;
|
||||
// Execute GET on server, store result in Stream, File, StringList or string
|
||||
@ -254,7 +274,8 @@ Type
|
||||
// Optional body to send (mainly in POST request)
|
||||
Property RequestBody : TStream read FRequestBody Write FRequestBody;
|
||||
// used HTTP version when constructing the request.
|
||||
Property HTTPversion : String Read FHTTPVersion Write FHTTPVersion;
|
||||
// Setting this to any other value than 1.1 will set KeepConnection to False.
|
||||
Property HTTPversion : String Read FHTTPVersion Write SetHTTPVersion;
|
||||
// After request properties.
|
||||
// After request, this contains the headers sent by server.
|
||||
Property ResponseHeaders : TStrings Read FResponseHeaders;
|
||||
@ -278,6 +299,10 @@ Type
|
||||
// They also override any Authenticate: header in Requestheaders.
|
||||
Property UserName : String Read FUserName Write FUserName;
|
||||
Property Password : String Read FPassword Write FPassword;
|
||||
// Is client connected?
|
||||
Property Connected: Boolean read IsConnected;
|
||||
// Keep-Alive support. Setting to true will set HTTPVersion to 1.1
|
||||
Property KeepConnection: Boolean Read FKeepConnection Write SetKeepConnection;
|
||||
// If a request returns a 401, then the OnPassword event is fired.
|
||||
// It can modify the username/password and set RepeatRequest to true;
|
||||
Property OnPassword : TPasswordEvent Read FOnPassword Write FOnPassword;
|
||||
@ -293,6 +318,8 @@ Type
|
||||
|
||||
TFPHTTPClient = Class(TFPCustomHTTPClient)
|
||||
Published
|
||||
Property KeepConnection;
|
||||
Property Connected;
|
||||
Property IOTimeout;
|
||||
Property RequestHeaders;
|
||||
Property RequestBody;
|
||||
@ -458,6 +485,11 @@ begin
|
||||
FSocket.IOTimeout:=AValue;
|
||||
end;
|
||||
|
||||
function TFPCustomHTTPClient.IsConnected: Boolean;
|
||||
begin
|
||||
Result := Assigned(FSocket);
|
||||
end;
|
||||
|
||||
function TFPCustomHTTPClient.NoContentAllowed(ACode: Integer): Boolean;
|
||||
begin
|
||||
Result:=((ACode div 100)=1) or ((ACode=204) or (ACode=304))
|
||||
@ -544,6 +576,8 @@ Var
|
||||
|
||||
|
||||
begin
|
||||
If IsConnected Then
|
||||
DisconnectFromServer; // avoid memory leaks
|
||||
if (Aport=0) then
|
||||
if UseSSL then
|
||||
Aport:=443
|
||||
@ -561,6 +595,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TFPCustomHTTPClient.ReconnectToServer(const AHost: String;
|
||||
APort: Integer; UseSSL: Boolean);
|
||||
begin
|
||||
DisconnectFromServer;
|
||||
ConnectToServer(AHost, APort, UseSSL);
|
||||
end;
|
||||
|
||||
procedure TFPCustomHTTPClient.DisconnectFromServer;
|
||||
|
||||
begin
|
||||
@ -573,6 +614,11 @@ begin
|
||||
Result:=(AHeader<>'') and (Pos(':',AHeader)<>0);
|
||||
end;
|
||||
|
||||
Function TFPCustomHTTPClient.HasConnectionClose: Boolean;
|
||||
begin
|
||||
Result := CompareText(GetHeader('Connection'), 'close') = 0;
|
||||
end;
|
||||
|
||||
procedure TFPCustomHTTPClient.SendRequest(const AMethod: String; URI: TURI);
|
||||
|
||||
Var
|
||||
@ -607,6 +653,7 @@ begin
|
||||
S:=S+CRLF;
|
||||
If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
|
||||
AddHeader('Content-Length',IntToStr(RequestBody.Size));
|
||||
CheckConnectionCloseHeader;
|
||||
For I:=0 to FRequestHeaders.Count-1 do
|
||||
begin
|
||||
l:=FRequestHeaders[i];
|
||||
@ -634,9 +681,9 @@ begin
|
||||
FSocket.CopyFrom(FRequestBody,FRequestBody.Size);
|
||||
end;
|
||||
|
||||
function TFPCustomHTTPClient.ReadString : String;
|
||||
function TFPCustomHTTPClient.ReadString(out S: String): Boolean;
|
||||
|
||||
Procedure FillBuffer;
|
||||
Function FillBuffer: Boolean;
|
||||
|
||||
Var
|
||||
R : Integer;
|
||||
@ -644,38 +691,42 @@ function TFPCustomHTTPClient.ReadString : String;
|
||||
begin
|
||||
SetLength(FBuffer,ReadBufLen);
|
||||
r:=FSocket.Read(FBuffer[1],ReadBufLen);
|
||||
If r=0 Then
|
||||
Exit(False);
|
||||
If r<0 then
|
||||
Raise EHTTPClient.Create(SErrReadingSocket);
|
||||
if (r<ReadBuflen) then
|
||||
SetLength(FBuffer,r);
|
||||
FDataRead:=FDataRead+R;
|
||||
DoDataRead;
|
||||
Result:=r>0;
|
||||
end;
|
||||
|
||||
Var
|
||||
CheckLF,Done : Boolean;
|
||||
CheckLF: Boolean;
|
||||
P,L : integer;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
Done:=False;
|
||||
S:='';
|
||||
Result:=False;
|
||||
CheckLF:=False;
|
||||
Repeat
|
||||
if Length(FBuffer)=0 then
|
||||
FillBuffer;
|
||||
if not FillBuffer then
|
||||
Break;
|
||||
if Length(FBuffer)=0 then
|
||||
Done:=True
|
||||
Result:=True
|
||||
else if CheckLF then
|
||||
begin
|
||||
If (FBuffer[1]<>#10) then
|
||||
Result:=Result+#13
|
||||
S:=S+#13
|
||||
else
|
||||
begin
|
||||
System.Delete(FBuffer,1,1);
|
||||
Done:=True;
|
||||
Result:=True;
|
||||
end;
|
||||
end;
|
||||
if not Done then
|
||||
if not Result then
|
||||
begin
|
||||
P:=Pos(#13#10,FBuffer);
|
||||
If P=0 then
|
||||
@ -683,20 +734,21 @@ begin
|
||||
L:=Length(FBuffer);
|
||||
CheckLF:=FBuffer[L]=#13;
|
||||
if CheckLF then
|
||||
Result:=Result+Copy(FBuffer,1,L-1)
|
||||
S:=S+Copy(FBuffer,1,L-1)
|
||||
else
|
||||
Result:=Result+FBuffer;
|
||||
S:=S+FBuffer;
|
||||
FBuffer:='';
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result:=Result+Copy(FBuffer,1,P-1);
|
||||
S:=S+Copy(FBuffer,1,P-1);
|
||||
System.Delete(FBuffer,1,P+1);
|
||||
Done:=True;
|
||||
Result:=True;
|
||||
end;
|
||||
end;
|
||||
until Done;
|
||||
until Result;
|
||||
end;
|
||||
|
||||
Function GetNextWord(Var S : String) : string;
|
||||
|
||||
Const
|
||||
@ -765,11 +817,11 @@ Var
|
||||
StatusLine,S : String;
|
||||
|
||||
begin
|
||||
StatusLine:=ReadString;
|
||||
if not ReadString(StatusLine) then
|
||||
Exit(0);
|
||||
Result:=ParseStatusLine(StatusLine);
|
||||
Repeat
|
||||
S:=ReadString;
|
||||
if (S<>'') then
|
||||
if ReadString(S) and (S<>'') then
|
||||
begin
|
||||
ResponseHeaders.Add(S);
|
||||
If (LowerCase(Copy(S,1,Length(SetCookie)))=SetCookie) then
|
||||
@ -877,14 +929,33 @@ begin
|
||||
GetCookies.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TFPCustomHTTPClient.SetHTTPVersion(const AValue: String);
|
||||
begin
|
||||
if FHTTPVersion = AValue then Exit;
|
||||
FHTTPVersion := AValue;
|
||||
if (AValue<>'1.1') then
|
||||
KeepConnection:=False;
|
||||
end;
|
||||
|
||||
procedure TFPCustomHTTPClient.SetKeepConnection(AValue: Boolean);
|
||||
begin
|
||||
if FKeepConnection=AValue then Exit;
|
||||
FKeepConnection:=AValue;
|
||||
if AValue then
|
||||
HTTPVersion:='1.1'
|
||||
else if IsConnected then
|
||||
DisconnectFromServer;
|
||||
CheckConnectionCloseHeader;
|
||||
end;
|
||||
|
||||
procedure TFPCustomHTTPClient.SetProxy(AValue: TProxyData);
|
||||
begin
|
||||
if (AValue=FProxy) then exit;
|
||||
Proxy.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream;
|
||||
const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean);
|
||||
Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
|
||||
const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean): Boolean;
|
||||
|
||||
Function Transfer(LB : Integer) : Integer;
|
||||
|
||||
@ -1012,6 +1083,9 @@ begin
|
||||
FContentLength:=0;
|
||||
SetLength(FBuffer,0);
|
||||
FResponseStatusCode:=ReadResponseHeaders;
|
||||
Result := FResponseStatusCode > 0;
|
||||
if not Result then
|
||||
Exit;
|
||||
if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
|
||||
Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
|
||||
if HeadersOnly Or (AllowRedirect and IsRedirect(FResponseStatusCode)) then
|
||||
@ -1050,13 +1124,99 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPCustomHTTPClient.DoMethod(const AMethod, AURL: String;
|
||||
Stream: TStream; const AllowedResponseCodes: array of Integer);
|
||||
Procedure TFPCustomHTTPClient.ExtractHostPort(AURI: TURI; Out AHost: String;
|
||||
Out APort: Word);
|
||||
Begin
|
||||
if ProxyActive then
|
||||
begin
|
||||
AHost:=Proxy.Host;
|
||||
APort:=Proxy.Port;
|
||||
end
|
||||
else
|
||||
begin
|
||||
AHost:=AURI.Host;
|
||||
APort:=AURI.Port;
|
||||
end;
|
||||
End;
|
||||
|
||||
procedure TFPCustomHTTPClient.CheckConnectionCloseHeader;
|
||||
|
||||
Var
|
||||
URI : TURI;
|
||||
P,CHost : String;
|
||||
CPort : Word;
|
||||
I : integer;
|
||||
N,V : String;
|
||||
|
||||
begin
|
||||
V:=GetHeader('Connection');
|
||||
If FKeepConnection Then
|
||||
begin
|
||||
I:=IndexOfHeader(FRequestHeaders,'Connection');
|
||||
If i>-1 Then
|
||||
begin
|
||||
// It can be keep-alive, check value
|
||||
FRequestHeaders.GetNameValue(I,N,V);
|
||||
If CompareText(V,'close')=0 then
|
||||
FRequestHeaders.Delete(i);
|
||||
end
|
||||
end
|
||||
Else
|
||||
AddHeader('Connection', 'close');
|
||||
end;
|
||||
|
||||
Procedure TFPCustomHTTPClient.DoNormalRequest(const AURI: TURI;
|
||||
const AMethod: string; AStream: TStream;
|
||||
const AAllowedResponseCodes: array of Integer;
|
||||
AHeadersOnly, AIsHttps: Boolean);
|
||||
|
||||
Var
|
||||
CHost: string;
|
||||
CPort: Word;
|
||||
|
||||
begin
|
||||
ExtractHostPort(AURI, CHost, CPort);
|
||||
ConnectToServer(CHost,CPort,AIsHttps);
|
||||
Try
|
||||
SendRequest(AMethod,AURI);
|
||||
ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
|
||||
Finally
|
||||
DisconnectFromServer;
|
||||
End;
|
||||
end;
|
||||
|
||||
Procedure TFPCustomHTTPClient.DoKeepConnectionRequest(const AURI: TURI;
|
||||
const AMethod: string; AStream: TStream;
|
||||
const AAllowedResponseCodes: array of Integer;
|
||||
AHeadersOnly, AIsHttps: Boolean);
|
||||
|
||||
Var
|
||||
T: Boolean;
|
||||
CHost: string;
|
||||
CPort: Word;
|
||||
|
||||
begin
|
||||
ExtractHostPort(AURI, CHost, CPort);
|
||||
T := False;
|
||||
Repeat
|
||||
If Not IsConnected Then
|
||||
ConnectToServer(CHost,CPort,AIsHttps);
|
||||
Try
|
||||
SendRequest(AMethod,AURI);
|
||||
T := ReadResponse(AStream,AAllowedResponseCodes,AHeadersOnly);
|
||||
If Not T Then
|
||||
ReconnectToServer(CHost,CPort,AIsHttps);
|
||||
Finally
|
||||
If HasConnectionClose Then
|
||||
DisconnectFromServer;
|
||||
End;
|
||||
Until T;
|
||||
end;
|
||||
|
||||
Procedure TFPCustomHTTPClient.DoMethod(Const AMethod, AURL: String;
|
||||
Stream: TStream; Const AllowedResponseCodes: Array of Integer);
|
||||
|
||||
Var
|
||||
URI: TURI;
|
||||
P: String;
|
||||
IsHttps, HeadersOnly: Boolean;
|
||||
|
||||
begin
|
||||
ResetResponse;
|
||||
@ -1064,23 +1224,12 @@ begin
|
||||
p:=LowerCase(URI.Protocol);
|
||||
If Not ((P='http') or (P='https')) then
|
||||
Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
|
||||
if ProxyActive then
|
||||
begin
|
||||
CHost:=Proxy.Host;
|
||||
CPort:=Proxy.Port;
|
||||
end
|
||||
IsHttps:=P='https';
|
||||
HeadersOnly:=CompareText(AMethod,'HEAD')=0;
|
||||
if FKeepConnection then
|
||||
DoKeepConnectionRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps)
|
||||
else
|
||||
begin
|
||||
CHost:=URI.Host;
|
||||
CPort:=URI.Port;
|
||||
end;
|
||||
ConnectToServer(CHost,CPort,P='https');
|
||||
try
|
||||
SendRequest(AMethod,URI);
|
||||
ReadResponse(Stream,AllowedResponseCodes,CompareText(AMethod,'HEAD')=0);
|
||||
finally
|
||||
DisconnectFromServer;
|
||||
end;
|
||||
DoNormalRequest(URI,AMethod,Stream,AllowedResponseCodes,HeadersOnly,IsHttps);
|
||||
end;
|
||||
|
||||
constructor TFPCustomHTTPClient.Create(AOwner: TComponent);
|
||||
@ -1089,13 +1238,17 @@ begin
|
||||
// Infinite timeout on most platforms
|
||||
FIOTimeout:=0;
|
||||
FRequestHeaders:=TStringList.Create;
|
||||
FRequestHeaders.NameValueSeparator:=':';
|
||||
FResponseHeaders:=TStringList.Create;
|
||||
FHTTPVersion:='1.1';
|
||||
FResponseHeaders.NameValueSeparator:=':';
|
||||
HTTPVersion:='1.1';
|
||||
FMaxRedirects:=DefMaxRedirects;
|
||||
end;
|
||||
|
||||
destructor TFPCustomHTTPClient.Destroy;
|
||||
begin
|
||||
if IsConnected then
|
||||
DisconnectFromServer;
|
||||
FreeAndNil(FProxy);
|
||||
FreeAndNil(FCookies);
|
||||
FreeAndNil(FSentCookies);
|
||||
@ -1205,7 +1358,7 @@ begin
|
||||
FOnPassword(Self,RR);
|
||||
end
|
||||
else
|
||||
RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'')
|
||||
RR:=AllowRedirect and IsRedirect(FResponseStatusCode) and (L<>'');
|
||||
until not RR;
|
||||
end;
|
||||
|
||||
@ -1273,7 +1426,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Get(AURL,Stream);
|
||||
finally
|
||||
Free;
|
||||
@ -1287,7 +1440,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Get(AURL,LocalFileName);
|
||||
finally
|
||||
Free;
|
||||
@ -1301,7 +1454,7 @@ class procedure TFPCustomHTTPClient.SimpleGet(const AURL: String;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Get(AURL,Response);
|
||||
finally
|
||||
Free;
|
||||
@ -1369,7 +1522,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Post(URL,Response);
|
||||
finally
|
||||
Free;
|
||||
@ -1383,7 +1536,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Post(URL,Response);
|
||||
finally
|
||||
Free;
|
||||
@ -1397,7 +1550,7 @@ class procedure TFPCustomHTTPClient.SimplePost(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Post(URL,LocalFileName);
|
||||
finally
|
||||
Free;
|
||||
@ -1410,7 +1563,7 @@ class function TFPCustomHTTPClient.SimplePost(const URL: string): String;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Result:=Post(URL);
|
||||
finally
|
||||
Free;
|
||||
@ -1461,7 +1614,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Put(URL,Response);
|
||||
finally
|
||||
Free;
|
||||
@ -1474,7 +1627,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Put(URL,Response);
|
||||
finally
|
||||
Free;
|
||||
@ -1487,7 +1640,7 @@ class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Put(URL,LocalFileName);
|
||||
finally
|
||||
Free;
|
||||
@ -1499,7 +1652,7 @@ class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Result:=Put(URL);
|
||||
finally
|
||||
Free;
|
||||
@ -1551,7 +1704,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Delete(URL,Response);
|
||||
finally
|
||||
Free;
|
||||
@ -1564,7 +1717,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Delete(URL,Response);
|
||||
finally
|
||||
Free;
|
||||
@ -1577,7 +1730,7 @@ class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Delete(URL,LocalFileName);
|
||||
finally
|
||||
Free;
|
||||
@ -1589,7 +1742,7 @@ class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Result:=Delete(URL);
|
||||
finally
|
||||
Free;
|
||||
@ -1641,7 +1794,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Options(URL,Response);
|
||||
finally
|
||||
Free;
|
||||
@ -1654,7 +1807,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Options(URL,Response);
|
||||
finally
|
||||
Free;
|
||||
@ -1667,7 +1820,7 @@ class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Options(URL,LocalFileName);
|
||||
finally
|
||||
Free;
|
||||
@ -1679,7 +1832,7 @@ class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Result:=Options(URL);
|
||||
finally
|
||||
Free;
|
||||
@ -1690,7 +1843,7 @@ class procedure TFPCustomHTTPClient.Head(AURL: String; Headers: TStrings);
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
HTTPMethod('HEAD', AURL, Nil, [200]);
|
||||
Headers.Assign(ResponseHeaders);
|
||||
Finally
|
||||
@ -1775,7 +1928,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
FormPost(URL,FormData,Response);
|
||||
Finally
|
||||
Free;
|
||||
@ -1789,7 +1942,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
FormPost(URL,FormData,Response);
|
||||
Finally
|
||||
Free;
|
||||
@ -1803,7 +1956,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
FormPost(URL,FormData,Response);
|
||||
Finally
|
||||
Free;
|
||||
@ -1816,7 +1969,7 @@ class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
FormPost(URL,FormData,Response);
|
||||
Finally
|
||||
Free;
|
||||
@ -1829,7 +1982,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Result:=FormPost(URL,FormData);
|
||||
Finally
|
||||
Free;
|
||||
@ -1842,7 +1995,7 @@ class function TFPCustomHTTPClient.SimpleFormPost(const URL: string;
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
Result:=FormPost(URL,FormData);
|
||||
Finally
|
||||
Free;
|
||||
@ -1921,7 +2074,7 @@ class procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName,
|
||||
begin
|
||||
With Self.Create(nil) do
|
||||
try
|
||||
RequestHeaders.Add('Connection: Close');
|
||||
KeepConnection := False;
|
||||
FileFormPost(AURL,AFieldName,AFileName,Response);
|
||||
Finally
|
||||
Free;
|
||||
|
||||
@ -340,7 +340,7 @@ end;
|
||||
|
||||
destructor TIniWebSession.Destroy;
|
||||
begin
|
||||
// In case an exception occured and UpdateResponse is not called,
|
||||
// In case an exception occurred and UpdateResponse is not called,
|
||||
// write the updates to disk and free FIniFile
|
||||
FreeIniFile;
|
||||
inherited Destroy;
|
||||
@ -376,7 +376,7 @@ begin
|
||||
SID := '';
|
||||
FSessionStarted := False;
|
||||
FTerminated := False;
|
||||
// If a exception occured during a prior request FIniFile is still not freed
|
||||
// If a exception occurred during a prior request FIniFile is still not freed
|
||||
if assigned(FIniFile) then FreeIniFile;
|
||||
If (SessionCookie='') then
|
||||
SessionCookie:=SFPWebSession;
|
||||
|
||||
@ -214,7 +214,7 @@ implementation
|
||||
|
||||
resourcestring
|
||||
rsNothingToRun = 'No main window defined, nothing to do...';
|
||||
rsErrorTitle = 'Error occured';
|
||||
rsErrorTitle = 'Error occurred';
|
||||
rsMessageTitle = 'Message';
|
||||
sErrWrongItemType = 'Items in list are not from TFPgtkMenuItem class.';
|
||||
|
||||
|
||||
@ -7420,7 +7420,7 @@ Var
|
||||
// The thread has completed compiling the package
|
||||
if AThread.CompilationOK then
|
||||
AThread.APackage.FTargetState:=tsCompiled
|
||||
else // A problem occured, stop the compilation
|
||||
else // A problem occurred, stop the compilation
|
||||
begin
|
||||
ErrorState:=true;
|
||||
ErrorMessage:=AThread.ErrorMessage;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -611,7 +611,7 @@ begin
|
||||
AssertNull('No second statement',L.B);
|
||||
L:=AssertListStatement('try..except block is statement list',El.BCatch);
|
||||
AssertAssignStatement('Correct assignment in except..end block',L.A,'b','c');
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),El.Ident);
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
|
||||
AssertNull('No second statement',L.B);
|
||||
end;
|
||||
|
||||
@ -648,7 +648,7 @@ begin
|
||||
O.Body:=CreateAssignStatement('b','c');
|
||||
// Convert
|
||||
El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),EL.Ident);
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
|
||||
L:=AssertListStatement('try..except block is statement list',El.BCatch);
|
||||
AssertNull('No second statement',L.B);
|
||||
I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
|
||||
@ -696,7 +696,7 @@ begin
|
||||
O.Body:=TPasImplRaise.Create('',Nil);
|
||||
// Convert
|
||||
El:=TJSTryFinallyStatement(Convert(T,TJSTryCatchStatement));
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),EL.Ident);
|
||||
AssertEquals('Correct exception object name',lowercase(DefaultJSExceptionObject),String(El.Ident));
|
||||
L:=AssertListStatement('try..except block is statement list',El.BCatch);
|
||||
AssertNull('No second statement',L.B);
|
||||
I:=TJSIfStatement(AssertElement('On block is if',TJSIfStatement,L.A));
|
||||
@ -782,7 +782,7 @@ begin
|
||||
S:=TPrimitiveExpr.Create(Nil,pekString,'''me''');
|
||||
E:=TestLiteralExpression(S,TJSLiteral);
|
||||
AssertEquals('Correct literal type',jstString,E.Value.ValueType);
|
||||
AssertEquals('Correct literal value','me',E.Value.AsString);
|
||||
AssertEquals('Correct literal value','me',String(E.Value.AsString));
|
||||
end;
|
||||
|
||||
Procedure TTestExpressionConverter.TestPrimitiveNumber;
|
||||
@ -843,7 +843,7 @@ Var
|
||||
begin
|
||||
Id:=TPrimitiveExpr.Create(Nil,pekIdent,'a');
|
||||
Res:=TJSPrimaryExpressionIdent(Convert(Id,TJSPrimaryExpressionIdent));
|
||||
AssertEquals('Correct identifier name','a',Res.Name);
|
||||
AssertEquals('Correct identifier name','a',String(Res.Name));
|
||||
end;
|
||||
|
||||
Procedure TTestExpressionConverter.TestUnaryMinus;
|
||||
@ -1203,7 +1203,7 @@ begin
|
||||
Uni:=TJSUnary(AssertElement('Sl.A is TJSUnary',TJSUnary,Sl.A));
|
||||
Asi:=TJSSimpleAssignStatement(AssertElement('Sl.A is TJSUnary',TJSSimpleAssignStatement,Uni.A));
|
||||
pex:=TJSPrimaryExpressionIdent(AssertElement('Asi.LHS is TJSPrimaryExpressionIdent',TJSPrimaryExpressionIdent,Asi.LHS));
|
||||
AssertEquals('Correct name','myclass',pex.Name);
|
||||
AssertEquals('Correct name','myclass',String(pex.Name));
|
||||
Call:=TJSCallExpression(AssertElement('Asi.Expr is TJSCallExpression',TJSCallExpression,Asi.Expr));
|
||||
if Call=nil then ;
|
||||
end;
|
||||
@ -1264,7 +1264,7 @@ end;
|
||||
Class procedure TTestConverter.AssertLiteral(Const Msg : String; Lit: TJSElement; AValue: TJSString);
|
||||
begin
|
||||
AssertLiteral(Msg,Lit,jstString);
|
||||
AssertEquals(Msg+': Correct value',AValue,TJSLiteral(Lit).Value.AsString);
|
||||
AssertEquals(Msg+': Correct value',String(AValue),String(TJSLiteral(Lit).Value.AsString));
|
||||
end;
|
||||
|
||||
Class procedure TTestConverter.AssertLiteral(Const Msg : String; Lit: TJSElement; AValue: TJSNumber);
|
||||
@ -1278,12 +1278,12 @@ Class procedure TTestConverter.AssertIdentifier(Const Msg: String;
|
||||
begin
|
||||
AssertNotNull(Msg+': Have instance',Ident);
|
||||
AssertEquals(Msg+': Correct class',TJSPrimaryExpressionIdent,Ident.ClassType);
|
||||
AssertEquals(Msg+': Correct name',AName,TJSPrimaryExpressionIdent(Ident).Name);
|
||||
AssertEquals(Msg+': Correct name',AName,String(TJSPrimaryExpressionIdent(Ident).Name));
|
||||
end;
|
||||
|
||||
Class Function TTestConverter.CreateLiteral(AValue: String): TPasExpr;
|
||||
begin
|
||||
Result:=TPrimitiveExpr.Create(Nil,pekString,'me');
|
||||
Result:=TPrimitiveExpr.Create(Nil,pekString,AValue);
|
||||
end;
|
||||
|
||||
Class Function TTestConverter.CreateLiteral(AValue: Double): TPasExpr;
|
||||
@ -1293,7 +1293,7 @@ Var
|
||||
|
||||
begin
|
||||
Str(AValue,S);
|
||||
Result:=TPrimitiveExpr.Create(Nil,pekNumber,S);
|
||||
Result:=TPrimitiveExpr.Create(Nil,pekNumber,Trim(S));
|
||||
end;
|
||||
|
||||
Class Function TTestConverter.CreateIdent(AName: String): TPrimitiveExpr;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -8414,7 +8414,7 @@ TYPE
|
||||
CONST
|
||||
MCN_GETDAYSTATE = (MCN_FIRST + 3);
|
||||
|
||||
// MCN_SELECT is sent whenever a selection has occured (via mouse or keyboard)
|
||||
// MCN_SELECT is sent whenever a selection has occurred (via mouse or keyboard)
|
||||
//
|
||||
TYPE
|
||||
|
||||
|
||||
@ -239,7 +239,7 @@ type
|
||||
cFramesAvailable: DWM_FRAME_COUNT;
|
||||
|
||||
// number of rendered frames that were never
|
||||
// displayed because composition occured too late
|
||||
// displayed because composition occurred too late
|
||||
cFramesDropped: DWM_FRAME_COUNT;
|
||||
|
||||
// number of times an old frame was composed
|
||||
|
||||
@ -2162,7 +2162,7 @@ type
|
||||
// The exception information stream contains the id of the thread that caused
|
||||
// the exception (ThreadId), the exception record for the exception
|
||||
// (ExceptionRecord) and an RVA to the thread context where the exception
|
||||
// occured.
|
||||
// occurred.
|
||||
//
|
||||
|
||||
PMINIDUMP_EXCEPTION_STREAM = ^MINIDUMP_EXCEPTION_STREAM;
|
||||
|
||||
@ -1361,7 +1361,7 @@ const
|
||||
{$EXTERNALSYM EV_ERR}
|
||||
EV_RING = $0100; // Ring signal detected
|
||||
{$EXTERNALSYM EV_RING}
|
||||
EV_PERR = $0200; // Printer error occured
|
||||
EV_PERR = $0200; // Printer error occurred
|
||||
{$EXTERNALSYM EV_PERR}
|
||||
EV_RX80FULL = $0400; // Receive buffer is 80 percent full
|
||||
{$EXTERNALSYM EV_RX80FULL}
|
||||
|
||||
@ -2005,7 +2005,7 @@ type
|
||||
// //
|
||||
// The following structures define disk performance //
|
||||
// statistics: specifically the locations of all the //
|
||||
// reads and writes which have occured on the disk. //
|
||||
// reads and writes which have occurred on the disk. //
|
||||
// //
|
||||
// To use these structures, you must issue an IOCTL_ //
|
||||
// DISK_HIST_STRUCTURE (with a DISK_HISTOGRAM) to //
|
||||
|
||||
@ -112,7 +112,7 @@ const
|
||||
// DLL whether this constitutes a workstation locking event.
|
||||
//
|
||||
// SCRNSVR_ACTIVITY - used to indicate that keyboard or mouse
|
||||
// activity occured while a secure screensaver was active.
|
||||
// activity occurred while a secure screensaver was active.
|
||||
//
|
||||
// SC_INSERT - used to indicate that a smart card has been inserted
|
||||
// to a compatible device
|
||||
|
||||
Loading…
Reference in New Issue
Block a user