[fpc-pascal]parameter is 0x0 on callback

[Marc Santhoff]

Am Fr, den 04.06.2004 schrieb Peter Vreman um 08:46:
[...]
> Without a full (short) example we can't do anything.

See below, I've tried to cut down the size without loosing to much
information this time ...

> > And why it worked fine on the 1.0.10 version of fpc?
> 
> 1.9.2 uses register calling by default.

I don't get that. Do you say it worked by accident?

The code:
------------------------
unit StateInput;

{$define debug}

interface

...
procedure setCustDataCallback(data: TCustomer);  cdecl;
...


implementation
procedure setCustDataCallback(data: TCustomer); cdecl;
begin
	writeln('Name is '+_data.Name);
	with _data do begin
		if (Name <> '') then gtk_entry_set_text(_me.entries[0], pchar(@Name));
		if (FirstName <> '') then gtk_entry_set_text(_me.entries[1], pchar(@FirstName));

...
end;

procedure showCustomerBrowser(btn: pGtkButton; data: gpointer); cdecl;
var
	ds: TDataSource;
begin
	writeln('SI: showCustomerBrowser start');
	if not(DBMan=NIL) then ds := DBMan.customers else writeln('SI: DBMan=NIL!');
	br := TCustomerBrowser.create(ds, @setCustDataCallback);
	writeln('SI: browser created');
	br.execute;
end;

---------------------------------

unit CustomerBrowser;

type
	TPropagateCallback = procedure(data: TCustomer);

	TCustomerBrowser = class
	public
		dialog: pGtkWidget; { access for caller granted }

		constructor create(data: TDataSource; callback: TPropagateCallback);
		destructor destroy; override;
		function execute: boolean;
	private
		btnOkay: pGtkWidget;
		btnCancel: pGtkWidget;
		headline: pGtkWidget;
		scroll: pGtkWidget;
	    	list: pGtkWidget;
		procedure fillCustomerList(l: pGtkCList);
	end;

procedure onCustOkay(data : pGtkCList ); cdecl;

var	{ should be props, doesn't work with callbacks }
	cbPropagate	: TPropagateCallback;
...
implementation

constructor TCustomerBrowser.create(data: TDataSource; callback: TPropagateCallback);
begin
	inherited create;
	_creating := TRUE;
	
	cbPropagate := callback;
...
end;

procedure onCustOkay(data : pGtkCList ); cdecl;
var
	src: TCustomer;
	dlg: pGtkDialog;
	btnOk: pGtkWidget;
	(*towait, remain : timespec;*)
begin
	if (selCursor > -1) then begin
		
		{ fetch selected entry }
		selCursor := datasrc.indexOfID(selCursor);
		gtk_clist_set_auto_sort(data, FALSE);
		src := TCustomer(datasrc.Items[selCursor]);
		{$ifdef debug} writeln(src.asCSV); {$endif}

		{ propagate selected entry }
		cbPropagate(src);

		gtk_widget_destroy(_me);
...
end;

----------------------------

unit CommonTypes;

interface
...
type
	TCustomerClass = class of TCustomer;
	TCustomer = class(TStorable)
		Name: AnsiString;
		FirstName: AnsiString;
		Street: AnsiString;
		Zip: Ansistring;
		City: AnsiString;
...
		function asCSV: AnsiString; override;
		procedure fillFromCSV(csv: AnsiString); override;
		class function getHeaderString: AnsiString; override; { first line of CSV format }
	end;

const
	SEP: char = ';';
	QT: char = '"';

implementation

function TCustomer.asCSV: AnsiString;
begin
	result := 	IntToStr(ID) +
			SEP + QT + Name + QT +
			SEP + QT + FirstName + QT +
			SEP + QT + Street + QT +
			SEP + QT + ZIP + QT +
			SEP + QT + City + QT +
			SEP + QT + Phone + QT +
...
	{$ifdef debug}writeln('CT:customer.asCSV:'+result);{$endif}
end;
---------------------

I hope there is a solution. As written, the TCustomer item "src" should
be handed over to the code calling the browser dialog and it's zero any
time in the callback in the first unit.

Writing out it's content in the code that makes the call to the callback
with "asCSV" works okay, the contained information is correct.

Marc