View Issue Details
ID | Project | Category | View Status | Date Submitted | Last Update |
---|---|---|---|---|---|
0036089 | FPC | Database | public | 2019-09-19 20:00 | 2019-09-20 10:40 |
Reporter | Zdravko Gabrovski | Assigned To | Michael Van Canneyt | ||
Priority | normal | Severity | minor | Reproducibility | always |
Status | closed | Resolution | fixed | ||
Platform | all | OS | all | ||
Product Version | 3.3.1 | ||||
Fixed in Version | 3.3.1 | ||||
Summary | 0036089: AV on TCustomSQLQuery.InternalInitFieldDefs | ||||
Description | When I try to add a fields to a TSQLQuery object, that is NOT OPEN(Active=false) inside Lazarus IDE with fields collection editor (see attached .png files), I received a AV exception. This cause IDE to crash and need to restart. The Only way to add a fields is to check "Actibe=true" before start a collection editor. After deep investigation and debug I found, that the problem comes from InternalInitFieldDefs method (sqldb.pp, line 3063), because the funcion call result "Cursor" called at line 3070 SQLConnection.AddFieldDefs(Cursor,FieldDefs); return an empty value (nil). It takes a TCustomSQLStatement FStatement Cursor variable, which is not initializied if TSQQuery obkect is not activated (Active=true). I did the following fix: At line 3070 in sqldb.pp I insert a code if Not Assigned (Cursor) Then FStatement.Prepare; Which prepares a statment and allocate cursor. This avoid AV message and IDE crash. | ||||
Steps To Reproduce | As described above. To simulate, please use attached project, use the "Test Update List" button. Please, point a TIBconnection to your favor firebird server and fb database. | ||||
Tags | No tags attached. | ||||
Fixed in Revision | 43037 | ||||
FPCOldBugId | |||||
FPCTarget | 4.0.0 | ||||
Attached Files |
|
|
testlookup.lpi (2,070 bytes)
<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> <Version Value="12"/> <PathDelim Value="\"/> <General> <SessionStorage Value="InProjectDir"/> <Title Value="testlookup"/> <Scaled Value="True"/> <ResourceType Value="res"/> <UseXPManifest Value="True"/> <XPManifest> <DpiAware Value="True"/> </XPManifest> <Icon Value="0"/> </General> <BuildModes> <Item Name="Default" Default="True"/> </BuildModes> <PublishOptions> <Version Value="2"/> <UseFileFilters Value="True"/> </PublishOptions> <RunParams> <FormatVersion Value="2"/> <Modes Count="0"/> </RunParams> <RequiredPackages Count="2"> <Item1> <PackageName Value="FCL"/> </Item1> <Item2> <PackageName Value="LCL"/> </Item2> </RequiredPackages> <Units> <Unit> <Filename Value="testlookup.lpr"/> <IsPartOfProject Value="True"/> </Unit> <Unit> <Filename Value="utestmain.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="Form1"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> </Unit> </Units> </ProjectOptions> <CompilerOptions> <Version Value="11"/> <PathDelim Value="\"/> <Target> <Filename Value="testlookup"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Linking> <Options> <Win32> <GraphicApplication Value="True"/> </Win32> </Options> </Linking> </CompilerOptions> <Debugging> <Exceptions Count="3"> <Item1> <Name Value="EAbort"/> </Item1> <Item2> <Name Value="ECodetoolError"/> </Item2> <Item3> <Name Value="EFOpenError"/> </Item3> </Exceptions> </Debugging> </CONFIG> testlookup.lpr (391 bytes)
program testlookup; {$mode objfpc}{$H+} uses {$IFDEF UNIX} cthreads, {$ENDIF} Interfaces, // this includes the LCL widgetset Forms, utestmain { you can add units after this }; {$R *.res} begin RequireDerivedFormResource := True; Application.Scaled := True; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. utestmain.lfm (3,823 bytes)
object Form1: TForm1 Left = 745 Height = 294 Top = 239 Width = 320 Caption = 'Form1' ClientHeight = 294 ClientWidth = 320 LCLVersion = '2.1.0.0' object DBGrid1: TDBGrid Left = 0 Height = 124 Top = 170 Width = 320 Align = alBottom Color = clWindow Columns = <> DataSource = DataSource1 TabOrder = 0 end object Button1: TButton Left = 176 Height = 25 Top = 97 Width = 112 Caption = 'Test with empty' OnClick = Button1Click TabOrder = 1 end object Button2: TButton Left = 176 Height = 25 Top = 128 Width = 112 Caption = 'Test with no empty' OnClick = Button2Click TabOrder = 2 end object Button3: TButton Left = 176 Height = 25 Top = 61 Width = 112 Caption = 'Test Update list' OnClick = Button3Click TabOrder = 3 end object Button4: TButton Left = 176 Height = 25 Top = 32 Width = 112 Caption = 'Test Update list - Open' OnClick = Button3Click TabOrder = 4 end object IBConnection1: TIBConnection Connected = False LoginPrompt = False DatabaseName = '10.10.10.232:/opt/db/hotel.fdb' KeepConnection = False Password = 'masterkey' Transaction = SQLTransaction1 UserName = 'SYSDBA' CharSet = 'UTF-8' CheckTransactionParams = False UseConnectionCharSetIfNone = True Left = 46 Top = 12 end object SQLQuery1: TSQLQuery IndexName = 'DEFAULT_ORDER' MaxIndexesCount = 4 FieldDefs = < item Name = 'ID' DataType = ftInteger Precision = -1 end> Database = IBConnection1 Transaction = SQLTransaction1 SQL.Strings = ( 'Select 1 as id from RDB$database' ) Params = <> Macros = <> Left = 40 Top = 80 object SQLQuery1ID: TLongintField FieldKind = fkData FieldName = 'ID' Index = 0 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = True end object StringField1: TStringField FieldKind = fkLookup FieldName = 'FNAME' Index = 1 KeyFields = 'ID' LookupCache = False LookupDataSet = SQLQuery2 LookupKeyFields = 'FID' LookupResultField = 'FNAME' ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = False end end object SQLTransaction1: TSQLTransaction Active = False Database = IBConnection1 Left = 104 Top = 40 end object SQLQuery2: TSQLQuery IndexName = 'DEFAULT_ORDER' MaxIndexesCount = 4 FieldDefs = < item Name = 'FID' DataType = ftInteger Precision = -1 end item Name = 'FNAME' DataType = ftFixedChar Precision = -1 Size = 4 end> Database = IBConnection1 Transaction = SQLTransaction1 SQL.Strings = ( 'Select 1 as fid,''Name'' as fName' 'from rdb$database' 'Where 1=1' ) Params = <> Macros = <> Left = 80 Top = 112 object SQLQuery2FID: TLongintField FieldKind = fkData FieldName = 'FID' Index = 0 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = True end object SQLQuery2FNAME: TStringField FieldKind = fkData FieldName = 'FNAME' Index = 1 LookupCache = False ProviderFlags = [pfInUpdate, pfInWhere] ReadOnly = False Required = True Size = 4 end end object DataSource1: TDataSource DataSet = SQLQuery1 Left = 24 Top = 128 end end utestmain.pas (1,467 bytes)
unit utestmain; {$mode objfpc}{$H+} interface uses Classes, SysUtils, IBConnection, SQLDB, DB, Forms, Controls, Graphics, Dialogs, DBGrids, StdCtrls; type { TForm1 } TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; DataSource1: TDataSource; DBGrid1: TDBGrid; IBConnection1: TIBConnection; SQLQuery1: TSQLQuery; SQLQuery1ID: TLongintField; SQLQuery2: TSQLQuery; SQLQuery2FID: TLongintField; SQLQuery2FNAME: TStringField; SQLTransaction1: TSQLTransaction; StringField1: TStringField; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private public end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.Button2Click(Sender: TObject); begin SQLQuery1.Close; SQLQuery2.Close; SQLQuery2.SQL[ 2 ] := ' Where 1=1'; SQLQuery2.Open; sqlQuery1.open end; procedure TForm1.Button3Click(Sender: TObject); begin if Sender=Button4 then SQLQuery1.open; SQLQuery1.FieldDefs.Update; SQLQuery1.Close; SQLTransaction1.Active := False; IBConnection1.Close; end; procedure TForm1.Button1Click(Sender: TObject); begin SQLQuery1.Close; SQLQuery2.Close; SQLQuery2.SQL[ 2 ] := ' Where 1=0'; SQLQuery2.Open; sqlQuery1.open end; end. |
|
This was fixed by another means, see rev r43037. |
|
It works fine, thanks for a great work! |
Date Modified | Username | Field | Change |
---|---|---|---|
2019-09-19 20:00 | Zdravko Gabrovski | New Issue | |
2019-09-19 20:00 | Zdravko Gabrovski | File Added: lazscreen.png | |
2019-09-19 20:00 | Zdravko Gabrovski | File Added: lazscreen1.png | |
2019-09-19 20:00 | Zdravko Gabrovski | File Added: testlookup.lpi | |
2019-09-19 20:00 | Zdravko Gabrovski | File Added: testlookup.lpr | |
2019-09-19 20:00 | Zdravko Gabrovski | File Added: utestmain.lfm | |
2019-09-19 20:00 | Zdravko Gabrovski | File Added: utestmain.pas | |
2019-09-19 23:28 | Michael Van Canneyt | Assigned To | => Michael Van Canneyt |
2019-09-19 23:28 | Michael Van Canneyt | Status | new => assigned |
2019-09-20 10:34 | Michael Van Canneyt | Status | assigned => resolved |
2019-09-20 10:34 | Michael Van Canneyt | Resolution | open => fixed |
2019-09-20 10:34 | Michael Van Canneyt | Fixed in Version | => 3.3.1 |
2019-09-20 10:34 | Michael Van Canneyt | Fixed in Revision | => 43037 |
2019-09-20 10:34 | Michael Van Canneyt | FPCTarget | => 4.0.0 |
2019-09-20 10:34 | Michael Van Canneyt | Note Added: 0118133 | |
2019-09-20 10:40 | Zdravko Gabrovski | Status | resolved => closed |
2019-09-20 10:40 | Zdravko Gabrovski | Note Added: 0118134 |