View Issue Details

IDProjectCategoryView StatusLast Update
0036089FPCDatabasepublic2019-09-20 10:40
ReporterZdravko Gabrovski Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
PlatformallOSall 
Product Version3.3.1 
Fixed in Version3.3.1 
Summary0036089: AV on TCustomSQLQuery.InternalInitFieldDefs
DescriptionWhen 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 ReproduceAs 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.
TagsNo tags attached.
Fixed in Revision43037
FPCOldBugId
FPCTarget4.0.0
Attached Files

Activities

Zdravko Gabrovski

2019-09-19 20:00

reporter  

lazscreen.png (206,556 bytes)   
lazscreen.png (206,556 bytes)   
lazscreen1.png (18,812 bytes)   
lazscreen1.png (18,812 bytes)   
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.lpi (2,070 bytes)   
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.

testlookup.lpr (391 bytes)   
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.lfm (3,823 bytes)   
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.

utestmain.pas (1,467 bytes)   

Michael Van Canneyt

2019-09-20 10:34

administrator   ~0118133

This was fixed by another means, see rev r43037.

Zdravko Gabrovski

2019-09-20 10:40

reporter   ~0118134

It works fine, thanks for a great work!

Issue History

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