Skip to content
Permalink
Browse files

fixed MongoDBTestCases for FPC

  • Loading branch information
Arnaud Bouchez
Arnaud Bouchez committed Mar 23, 2020
1 parent 389db13 commit e84c10acaa7ca466152df8a54f317ee6cfabb54f
Showing with 21 additions and 14 deletions.
  1. +11 −5 SQLite3/Samples/24 - MongoDB/MongoDBTestCases.pas
  2. +5 −4 SynCrtSock.pas
  3. +4 −4 SynDBPostgres.pas
  4. +1 −1 SynopseCommit.inc
@@ -21,6 +21,11 @@ interface
mORMotSQLite3,
mORMotMongoDB;

const
MONGOSERVER = 'localhost';
// MONGOSERVER = '10.0.2.2'; // from a VirtualBox VM
MONGOPORT = 27017;

type
TTestDirect = class(TSynTestCase)
protected
@@ -145,7 +150,7 @@ procedure TTestDirect.ConnectToLocalServer;
assert(fClient=nil);
{$ifdef TESTMONGOAUTH}
if not UserCreated then begin
fClient := TMongoClient.Create('localhost',27017);
fClient := TMongoClient.Create(MONGOSERVER,MONGOPORT);
with fClient.Database[DB_NAME] do begin
DropUser(USER_NAME);
Check(CreateUserForThisDatabase(USER_NAME,USER_PWD,true)='');
@@ -154,7 +159,7 @@ procedure TTestDirect.ConnectToLocalServer;
UserCreated := true;
end;
{$endif}
fClient := TMongoClient.Create('localhost',27017);
fClient := TMongoClient.Create(MONGOSERVER,MONGOPORT);
if ClassType=TTestDirectWithAcknowledge then
fClient.WriteConcern := wcAcknowledged else
if ClassType=TTestDirectWithoutAcknowledge then
@@ -217,7 +222,7 @@ procedure TTestDirect.DropAndPrepareCollection;

procedure TTestDirect.FillCollection;
var Coll: TMongoCollection;
oid: TBSONObjectID;
oid, oid2: TBSONObjectID;
i: integer;
jsonArray: RawUTF8;
bytes: Int64;
@@ -230,7 +235,8 @@ procedure TTestDirect.FillCollection;
for i := 0 to COLL_COUNT-1 do begin
Check(Coll.Save(fValues[i],@oid)=(i<50));
Check(BSONVariantType.IsOfKind(fValues[i]._id,betObjectID));
Check(fValues[i]._id=oid.ToVariant,'EnsureDocumentHasID failure');
Check(oid2.FromVariant(fValues[i]._id));
Check(oid2.Equal(oid),'EnsureDocumentHasID failure');
end;
NotifyTestSpeed('rows inserted',COLL_COUNT,fClient.BytesTransmitted-bytes);
Check(Coll.Count=COLL_COUNT);
@@ -370,7 +376,7 @@ procedure TTestDirect.DeleteSomeItems;

procedure TTestORM.ConnectToLocalServer;
begin
fMongoClient := TMongoClient.Create('localhost',27017);
fMongoClient := TMongoClient.Create(MONGOSERVER,MONGOPORT);
if ClassType=TTestORMWithAcknowledge then
fMongoClient.WriteConcern := wcAcknowledged else
if ClassType=TTestORMWithoutAcknowledge then
@@ -4719,12 +4719,13 @@ function OutputSock(var F: TTextRec): integer;
result := -1; // on socket error -> raise ioresult error
end;

function WSAIsFatalError: boolean;
function WSAIsFatalError(anothernonfatal: integer=NO_ERROR): boolean;
var err: integer;
begin
err := WSAGetLastError;
result := (err<>NO_ERROR) and (err<>WSATRY_AGAIN) and (err<>WSAEINTR) and (err<>WSAEADDRNOTAVAIL)
{$ifdef MSWINDOWS}and (err<>WSAETIMEDOUT) and (err<>WSAEWOULDBLOCK){$endif};
result := (err<>NO_ERROR) and (err<>WSATRY_AGAIN) and (err<>WSAEINTR) and
{$ifdef MSWINDOWS}(err<>WSAETIMEDOUT) and (err<>WSAEWOULDBLOCK) and{$endif}
(err<>anothernonfatal); // allow WSAEADDRNOTAVAIL from OpenBind()
end;

function WSAErrorAtShutdown(sock: TSocket): integer;
@@ -4910,7 +4911,7 @@ procedure TCrtSocket.OpenBind(const aServer, aPort: SockString;
retry := {$ifdef BSD}10{$else}2{$endif};
repeat
fSock := CallServer(aServer,Port,doBind,aLayer,Timeout); // OPEN or BIND
if (fSock>0) or WSAIsFatalError then
if (fSock>0) or WSAIsFatalError(WSAEADDRNOTAVAIL) then
break;
dec(retry);
if retry<=0 then
@@ -17,9 +17,9 @@
- works with PostgreSQL>=7.4 and (v3 protocol)
- consider creating the database with UTF8 collation
- notifications are not implemented
- Postgres level prepared statements works only for SQLs what starts
- Postgres level prepared cached statements works only for SQLs what starts
exactly with SELECT INSERT UPDATE DELETE VALUES and not contains ";"
- parameter parser will fails in case SQL contains comments with ? inside
- parameters parser will fails in case SQL contains comments with ? inside
(TODO - will be fixed)
- all query rows are returned at once, caller should care about pagination
(TODO - implement singleRowMode?)
@@ -93,7 +93,7 @@ TSQLDBPostgresConnection = class(TSQLDBConnectionThreadSafe)
// fServerSettings: set of (ssByteAasHex);
// maintain fPrepared[] hash list to identify already cached
function PrepareCached(const aSQL: RawUTF8; aParamCount: integer;
out aName: RaWUTF8): integer;
out aName: RawUTF8): integer;
/// direct execution of SQL statement what do not returns a result
// - statement should not contains parameters
// - raise an ESQLDBPostgres on error
@@ -446,7 +446,7 @@ procedure TSQLDBPostgresLib.Check(conn: PPGconn; res: PPGresult; pRes: PPPGresul
{ TSQLDBPostgresConnection }

function TSQLDBPostgresConnection.PrepareCached(const aSQL: RawUTF8; aParamCount: integer;
out aName: RaWUTF8): integer;
out aName: RawUTF8): integer;
var
dig: TSHA256Digest;
begin
@@ -1 +1 @@
'1.18.5882'
'1.18.5883'

0 comments on commit e84c10a

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