Uing the following class code in Lazarus I get the following error on the writeln(woman.name, 'has been born'); line: "Project My Application raised exception class 'External SIGSEV'. Other pascal code seems to work ok
program project1;
uses wincrt;
type human = class
private
health : integer;
public
name : string;
constructor born(n: string);
end;
constructor human.born(n: string);
begin
name := n;
health := 100;
end;
var
woman : human;
begin
woman.born('Tracy');
writeln(woman.name, 'has been born');
end.
You need to instantiate object this way:
woman := human.born('Tracy');
Related
I simplified the following code at the maximum to only show my problem.
When the destructor TClass3.Destroy is done, the action FreeAndNil(FClass3) causes a problem and the program stops. If have a look in the Heap.trc file I can read
Marked memory at $0000000001528FD0 invalid
Wrong signature $2951FD2D instead of 5C063D8B
program Project_testFree;
{$mode objfpc}{$H+}
uses
sysutils;
type
TClass1 = class
private
protected
public
constructor Create;
end;
TClass2 = class(TClass1)
private
protected
FTClass2 : cardinal;
public
end;
TClass3 = class
private
protected
FClass3 : TClass1;
public
constructor Create;virtual;
destructor Destroy;override;
end;
TClass4 = class(TClass3)
private
function GetLocalClass2: TClass2;
protected
public
constructor Create;override;
destructor destroy;override;
property pClass2:TClass2 read GetLocalClass2;
end;
constructor TClass1.Create;
begin
inherited;
end;
constructor TClass3.Create;
begin
FClass3 := TClass1.create;
end;
destructor TClass3.Destroy;
begin
FreeAndNil(FClass3);
writeln('Destroy');
inherited Destroy;
end;
constructor TClass4.Create;
begin
inherited Create;
pClass2.FTClass2 := 1;
end;
destructor TClass4.destroy;
begin
inherited destroy;
end;
function TClass4.GetLocalClass2: TClass2;
begin
result := TClass2(FClass3);
end;
var
c:TClass4;
begin
if FileExists('heap.trc') then
DeleteFile('heap.trc');
SetHeapTraceOutput('heap.trc');
c:=TClass4.Create;
c.free;
end.
I use Lazarus 1.6.2.
Thanks for your help.
You cast FClass3 to be TClass2. But you instantiated TClass1. The cast is therefore incorrect which would explain the error. Essentially, you lied to the compiler and it exacted its revenge.
Had you used a checked cast, using as, then a runtime error would have been raised.
Whenever I run SafteyDepositBox.SetNewCode I get a runtime error 216. Any idea whats causing this?
This is the error :
Runtime error 216 at $00401EFC $00401EFC $0040153D
$00401596 $00406E31
program Boxy;
{$MODE OBJFPC}
{$M+}
type
SDB = class
private
State : string;
Code : string;
public
Constructor Create();
procedure SetNewCode(newcode:string);
function Valid(s:string):boolean;
end;
constructor SDB.Create();
begin
State := 'Open-NoCode';
Code := '';
end;
procedure SDB.SetNewCode(newcode:string);
begin
Code := newcode;
writeln(Code);
end;
function SDB.Valid(s:string):boolean;
var
IsValid : boolean;
begin
If (length(s) = 4) then
IsValid := true
else
IsValid := false;
Valid := IsValid;
end;
var
SafetyDepositBox : SDB;
begin
SafetyDepositBox.Create();
SafetyDepositBox.SetNewCode('r2d2');// runtime error 216 here
end.
OMG you just made me remember Pascal!
This is how you call the object constructor:
SafetyDepositBox := SDB.Create();
I have made some very simple code in Pascal that is getting me this error:
Project BugFixing.exe raised exception class EAccessViolation with message 'Access violation at address 0040F1EE in module 'BugFixing.exe'. Write of address 00000004'.
The program consists of 2 modules:
BugFixing.dpr:
program BugFixing;
{$APPTYPE CONSOLE}
uses
SysUtils, uLinearProgrammingMainLogic in 'uLinearProgrammingMainLogic.pas', math;
var
MinOrMax : integer ;
Question : TQuestion ;
begin
try
Randomize ;
MinOrMax := RandomRange(0,2) ;
Question.SetMaximiseQuestion(MinOrMax);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
And uLinearProgrammingMainLogic.pas:
unit uLinearProgrammingMainLogic;
interface
uses sysUtils, math ;
type
TQuestion = class
private
MaximiseQuestion : boolean ;
public
procedure SetMaximiseQuestion (MinOrMax : integer) ;
end;
implementation
procedure TQuestion.SetMaximiseQuestion(MinOrMax : integer);
begin
if MinOrMax = 0 then
MaximiseQuestion := true
else
MaximiseQuestion := false ;
end;
end.
If anyone could explain to me why this is creating an access violation, that'd be appreciated. Thanks in advance. :)
A class must always be instantiated (TClassType.create) before use. The only exception to that are class/static methods, but you don't declare them that way (and that is not basic usage anyway)
I am trying to add NSStatusItem in a Delphi application for OSX. Searched for sample code to help me with that but got stuck when defining an interface:
Here is the code:
// Source: https://forums.embarcadero.com/thread.jspa?threadID=108449
unit Unit2;
interface
uses Macapi.ObjectiveC, Macapi.CocoaTypes, Macapi.Foundation, Macapi.AppKit,
Macapi.Helpers, Macapi.ObjcRuntime, System.TypInfo, FMX.Platform, FMX.Platform.Mac;
type
TFMXTrayItem = class(TOCLocal)
private
NSStatItem : NSStatusItem;
public
constructor Create;
destructor Destroy; override;
function GetObjectiveCClass: PTypeInfo; override;
procedure call_mymethod; cdecl;
end;
implementation
constructor TFMXTrayItem.Create;
var
NSContMenu : NSMenu;
NSContItem : NSMenuItem;
NSStatBar : NSStatusBar;
NSImg : NSImage;
AppBundle : NSBundle;
NSpImg: Pointer;
Path: String;
begin
inherited Create;
NSStatBar := TNSStatusBar.Create;
NSStatBar := TNSStatusBar.Wrap(TNSStatusBar.OCClass.systemStatusBar);
NSStatItem:= NSStatBar.statusItemWithLength(NSVariableStatusItemLength);
NSStatItem.setTarget(GetObjectID);
// Create context menu
NSContMenu := TNSMenu.Create;
NSContMenu := TNSMenu.Wrap(NSContMenu.initWithTitle(StrToNSStr('The caption')));
NSContItem:=TNSMenuItem.Create;
NSContItem:=TNSMenuItem.Wrap(NSContItem.initWithTitle(StrToNSStr('1. menuitem'),sel_getUid(PAnsiChar('call_mymethod')),StrToNSStr('')));
NSContItem.setTarget(GetObjectID);
NSContMenu.addItem(NSContItem);
NSContItem.release;
// Add menu
NSStatItem.retain;
NSStatItem.setHighlightMode(true);
NSStatItem.setMenu(NSContMenu);
NSContMenu.release;
// Get path to dir
AppBundle := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
Path:=AppBundle.bundlePath.UTF8String+'/Contents/yourimage16x16.png';
NSpImg := TNSImage.Alloc.initWithContentsOfFile(StrToNSStr(Path));
// Create Icon
NSImg := TNSImage.Create;
NSImg := TNSImage.Wrap(NSpImg);
NSStatItem.setImage(NSImg);
NSImg.release;
end;
destructor TFMXTrayItem.Destroy;
begin
NSStatItem.release;
inherited;
end;
function TFMXTrayItem.GetObjectiveCClass: PTypeInfo;
begin
Result :=TypeInfo(IFMXTrayItem);
end;
procedure TFMXTrayItem.call_properties;
begin
// your event code of the menu item
end;
end.
Does anyone have any idea on how to declare the IFMXTrayItem interface?
Got it to work like this:
type
IFMXTrayItem = interface(NSObject)
['{7d2e4b38-61d9-4cf4-b78b-5f7c4188e9c0}']
procedure call_mymethod; cdecl;
end;
later edit:
Added a GUID to the interface after reading this:
This GUID is used by the compiler to identify uniquely this interface.
Strictly speaking, you can use an interface without the GUID, but you
can’t get very far using them as much of the RTL and most frameworks
that take advantage of interfaces will require that they have a GUID.
So that is a random GUID I generated but if you use this in your code you should generate your own GUID.
What I'm trying to do is to get the list of fields in a class without an instance... for example:
TAClass=class
a_: Integer;
b_: Integer;
constructor (a,b Integer);
end;
I'm not being able to get the fieldTable from the VMT:
ovmt: PVmt;
ftable: PVmtFieldTable;
finfo: PVmtFieldEntry;
ovmt:=PVmt(TAClass);
ftable := ovmt^.vfieldtable
finfo := ftable^.fields[0]
this way I'm not gettig the list of fields
any help is welcome,
thanks in advance
Afaik the field tables in classic delphi and FPC only work for published fields. Published fields must be class fields (value types like integer must go via properties). Newer Delphi's also allow RTTI for non published fields, but that works differently (different untis), and FPC doesn't support that yet.
I hacked together a small demonstration example since the help for typinfo seems to be light on examples. Note the tpersistent derivation.
{$mode delphi}
uses typinfo,classes;
type
TAClass=class(Tpersistent)
a: tstringlist;
b: tlist;
end;
var
ovmt: PVmt;
FieldTable: PVMTFieldTable;
PVMTFieldEntry;
i: longint;
begin
ovmt := PVmt(TAClass);
while ovmt <> nil do
begin
FieldTable := PVMTFieldTable(ovmt^.vFieldTable);
if FieldTable <> nil then
begin
FieldInfo := #FieldTable^.Fields[0];
for i := 0 to FieldTable^.Count - 1 do
begin
writeln(fieldinfo^.name);
FieldInfo := PvmtFieldEntry(PByte(#FieldInfo^.Name) + 1 + Length(FieldInfo^.Name));
end;
end;
{ Try again with the parent class type }
ovmt:=ovmt^.vParent;
end;
end.