paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 10:19:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Trim stringfields longer then dsMaxStringSize in IBConnection + test. (bug 9600)

Browse Source 
git-svn-id: trunk@8859 -
This commit is contained in:
joost 2007-10-19 22:38:35 +00:00
parent adbd4cd6c7
commit 13722257b6
2 changed files with 35 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
packages/fcl-db/src/sqldb/interbase/ibconnection.pp
View File

@ -418,15 +418,13 @@ begin
TrType := ftFMTBcd; TrType := ftFMTBcd;
end end
else case (SQLType and not 1) of else case (SQLType and not 1) of
SQL_VARYING : SQL_VARYING,SQL_TEXT :
begin begin
TrType := ftString; TrType := ftString;
TrLen := SQLLen; if SQLLen > dsMaxStringSize then
end; TrLen := dsMaxStringSize
SQL_TEXT : else
begin TrLen := SQLLen;
TrType := ftString;
TrLen := SQLLen;
end; end;
SQL_TYPE_DATE : SQL_TYPE_DATE :
TrType := ftDate{Time}; TrType := ftDate{Time};
@ -791,12 +789,14 @@ begin
if ((SQLType and not 1) = SQL_VARYING) then if ((SQLType and not 1) = SQL_VARYING) then
begin begin
Move(SQLData^, VarcharLen, 2); Move(SQLData^, VarcharLen, 2);
if VarcharLen > dsMaxStringSize then
VarcharLen:=dsMaxStringSize;
CurrBuff := SQLData + 2; CurrBuff := SQLData + 2;
end end
else else
begin begin
CurrBuff := SQLData; CurrBuff := SQLData;
VarCharLen := SQLDA^.SQLVar[x].SQLLen; VarCharLen := FieldDef.Size;
end; end;
Result := true; Result := true;
@ -827,7 +827,7 @@ begin
GetDateTime(CurrBuff, Buffer, SQLDA^.SQLVar[x].SQLType); GetDateTime(CurrBuff, Buffer, SQLDA^.SQLVar[x].SQLType);
ftString : ftString :
begin begin
Move(CurrBuff^, Buffer^, SQLDA^.SQLVar[x].SQLLen); Move(CurrBuff^, Buffer^, VarCharLen);
PChar(Buffer + VarCharLen)^ := #0; PChar(Buffer + VarCharLen)^ := #0;
end; end;
ftFloat : ftFloat :

27
packages/fcl-db/tests/testsqlfieldtypes.pas
View File

@ -26,7 +26,8 @@ type
procedure TearDown; override; procedure TearDown; override;
procedure RunTest; override; procedure RunTest; override;
published published
procedure TestRowsAffected; procedure TestInsertLargeStringFields; // bug 9600
procedure TestRowsAffected; // bug 9758
procedure TestStringsReplace; procedure TestStringsReplace;
procedure TestCircularParams; procedure TestCircularParams;
procedure Test11Params; procedure Test11Params;
@ -871,6 +872,28 @@ begin
inherited RunTest; inherited RunTest;
end; end;
procedure TTestFieldTypes.TestInsertLargeStringFields;
begin
with TSQLDBConnector(DBConnector) do
begin
Connection.ExecuteDirect('create table FPDEV2 ( ' +
' ID INT NOT NULL , ' +
' NAME VARCHAR(16000), ' +
' PRIMARY KEY (ID) ' +
') ');
// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
Query.ExecSQL;
query.sql.Text:='select * from FPDEV2';
Query.Open;
AssertEquals(query.FieldByName('NAME').AsString,'test1');
Query.insert;
query.fields[1].AsString:='11';
query.Close;
end;
end;
procedure TTestFieldTypes.TestRowsAffected; procedure TTestFieldTypes.TestRowsAffected;
begin begin
with TSQLDBConnector(DBConnector) do with TSQLDBConnector(DBConnector) do
@ -880,6 +903,8 @@ begin
' NAME VARCHAR(250), ' + ' NAME VARCHAR(250), ' +
' PRIMARY KEY (ID) ' + ' PRIMARY KEY (ID) ' +
') '); ') ');
// Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')'; Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
Query.ExecSQL; Query.ExecSQL;
AssertEquals(1,query.RowsAffected); AssertEquals(1,query.RowsAffected);