I'm looking for a way to check if two pointers are addressing the same memory location I thought I could check the two pointer adresses but they seems to be different. So how can I check if a Pointer targets to the same memory location as another?
procedure TForm2.btnTestClick(Sender: TObject);
var
tmp : Tobject;
p1,p2 :Pointer;
begin
tmp:=self;
p1:=#self;
p2:=#tmp;
if(p1=p2) then begin
ShowMessage('true');
end else begin
ShowMessage('false');
end;
end;
I'm using Embarcadero Delphi 11 but this should not make any difference here.
Related
I suspect that a double-free error leads to an access violation (later in the same program).
The given class contains a Generic TDictionary and assigns a ChangeNotification handler after creating it using FMyDict.OnValueNotify := ChangeNotification;
procedure TMyClass.ChangeNotification(Sender: TObject; const Item: TMyValueType; Action: TCollectionNotification);
begin
if Action = cnRemoved then begin
Item.Free;
end;
end;
If I uncomment the Item.Free, the AV does no longer occur.
But because the AV appears sporiadically (once in several hundreds of loop iterations in the program) I can't exactly prove that there is a double free situation.
My first idea is to set some "marker" in the object before freeing it. On the second free I could see that this marker is set.
Or is there a different "best practice" for detection of a double-free?
Is there any way to generate functions at compile-time in Ada? I want to generate an opcode table that stores function pointers. My current solution is to store objects containing a procedure that can be executed, but I'd rather not allocate if possible.
No.
But there's nothing wrong with having a domain-specific language (DSL) from which you generate Ada. That happens regularly.
You can use a generic procedure to have a generic body and just supply whatever unique parameters you need to it
with Ada.Text_IO; use Ada.Text_IO;
procedure Hello is
generic
-- some sort of parameters
Value : Integer;
procedure Do_Op;
procedure Do_Op is
begin
Put_Line(Integer'Image(Value));
end Do_Op;
procedure Op1 is new Do_Op(1);
procedure Op2 is new Do_Op(2);
procedure Op3 is new Do_Op(3);
begin
Put_Line("Hello, world!");
Op1;
Op2;
Op3;
end Hello;
Compiling the following program without optimization, and then running it, I see Program_Error,
raised PROGRAM_ERROR : addreq.adb:16 explicit raise
or, updating in view of Simon Wright's answer,
raised PROGRAM_ERROR : using address
This happens when using GNAT GPL 2014 on either Mac OS X or on GNU/Linux x84_64, on Linux, strangely, only for my program. Other versions of GNAT produce code that doesn't raise, older compilers do not accept (access-to-function parameters being more recent, I'm not surprised). Since my program needs to identify addresses of subprograms, I was hoping for a definitive statement in the RM; 13.3 (11) has ramifications that grow waivers, IINM. So, referring to the program below, would
Yes_no.all'Address = No'Adress
be a true statement if interpreted by the LRM? Legit? Is Yes_No.all actually a proper way to refer to the function No (if taking the 'Address)? As there is indirection through different pointer types, one having deeper accessibility, does this change the picture? I was thinking that Yes_No.all should yield the same 'Address as No, but apparently not, with some compilers.
with System;
procedure Addreq is
function No (Ignored : Integer) return Boolean is
begin
return False;
end No;
procedure Taking
(Yes_No : access function (N : Integer) return Boolean)
is
use type System.Address;
begin
if Yes_No.all'Address /= No'Address then
raise Program_Error;
end if;
end Taking;
begin
Taking (No'Access);
end Addreq;
One more update: if I make Addreq a package and have another subprogram call Taking, thus
with Addreq; -- now a package
procedure Driver is
use Addreq;
begin
Taking (No'Access);
end Driver;
then no exception is raised.
I think it must depend on your OS and compiler. Using FSF GCC 5.1.0 on Mac OS X, your code doesn’t raise the exception.
That said, I think it’d be more natural to avoid .all’Address (I was told by one of the Ada 95 Distinguished Reviewers that he’d got into the habit of saying .all’Access when what was really needed was an appropriate type conversion). This extension of your code doesn’t raise the exception for either case.
with Ada.Text_IO; use Ada.Text_IO;
with System;
procedure Addreq is
function No (Ignored : Integer) return Boolean is
begin
return False;
end No;
procedure Taking
(Yes_No : access function (N : Integer) return Boolean)
is
use type System.Address;
begin
if Yes_No.all'Address /= No'Address then
raise Program_Error with "using address";
end if;
Put_Line ("using address was OK");
if Yes_No /= No'Access then
raise Program_Error with "using access";
end if;
Put_Line ("using access was OK");
end Taking;
begin
Taking (No'Access);
end Addreq;
(later)
I rewrote this to not use exceptions ...
with Ada.Text_IO; use Ada.Text_IO;
with System;
procedure Addreq is
function No (Ignored : Integer) return Boolean is
begin
return False;
end No;
procedure Taking
(Yes_No : access function (N : Integer) return Boolean)
is
use type System.Address;
begin
Put_Line
((if Yes_No.all'Address /= No'Address
then "using address failed"
else "using address was OK"));
Put_Line
((if Yes_No /= No'Access
then "using access failed"
else "using access was OK"));
end Taking;
begin
Taking (No'Access);
end Addreq;
With GNAT GPL 2014 on Mac OS X, this gives
$ ./addreq
using address failed
using access was OK
If Yes_No.all'Address is not equal to No'Address, then most likely Yes_No.all'Address is the address of some kind of wrapper code.
No is a function nested inside a procedure. If you say No'access, the compiler generally cannot simply create a one-word pointer whose value is the address of No. The reason is that when the code makes an indirect call through the access value, the code has to do something special so that No can access local variables belonging to addreq, which will be somewhere on the stack. For example, one way to provide this access is to pass a static link as a parameter to No; this is an extra pointer that points to addreq's stack frame, which will contain its local variables (or something along those lines). Thus, when an indirect call is made through the access, the caller has to know what the static link is. One solution is to make nested access-to-function types dope vectors, that contain the function address and the static link. Another is to generate wrapper code. The wrapper code is responsible for calling the called subprogram with the static link parameter, and the access value is then simply a one-word pointer, which is the address of the wrapper code. I believe GNAT takes this approach. The advantage is that it makes it possible to pass My_Function'access as a parameter to a C function, for use as a callback. When the C code calls through the function pointer, it calls the wrapper function which then calls the nested function with the correct static link. There is a significant amount of public Ada code that depends on this mechanism. (GtkAda relies heavily on it.)
However, if the access value points to a wrapper, instead of the actual function, then The_Access.all'Address won't return what you think it should. When the code executes The_Access.all'Address, if The_Access is a single word with an address in it, that's all the attribute can return--the address in the pointer.
More: I don't know whether the original code is part of a larger example or just a test to see what the compiler does. But comparing 'Address values to see if a subprogram-access parameter refers to a specific subprogram strikes me a poor design, and comparing 'Access is no better. I would avoid doing that even in C. There's likely to be a more object-oriented solution to the problem (note that you can use tagged types to cause indirect subprogram calls to take place, because tagged type operations are dispatching). E.g.
type Boolean_Function_Object is abstract tagged null record;
function Apply (Obj : Boolean_Function_Object; N : Integer) return boolean;
function Is_Constant_False (Obj : Boolean_Function_Object) return boolean;
type No_Function is new Boolean_Function_Object with null record;
overriding
function Apply (Obj : No_Function; N : Integer) return boolean is (False);
overriding
function Is_Constant_False (Obj : No_Function) return boolean is (True);
procedure Taking (Func : Boolean_Function_Object) is
begin
if not Func.Is_Constant_False then
raise Program_Error;
end if;
end Taking;
Might not be the best design in all cases, but something like this should be considered if there seems to be a need to check a subprogram address to a particular subprogram. For one thing, this is more flexible; a programmer can define another derived type where Apply always return False but does something else, such as writing the argument to a log file.
Without copy-pasting my code here, how can I stop my ADA program from executing anymore lines of code during run-time if it calculates a certain value to 'X'?
something like:
variable_name := variable_name +4;
if variable_name >1 then
// END program here and dont execute any lines under this one
end if
I am not new to programming but new to ADA so finding the correct syntax is a pain. Any help?
There isn’t any specific syntax for this.
If you are in the main procedure, a simple return will do.
An Ada83-compatible answer is here on SO.
Both those are OK so long as you don’t have any tasks.
There’s an Ada95 Rosetta Code solution, which will work whether you have tasks or not:
with Ada.Task_Identification; use Ada.Task_Identification;
procedure Main is
-- Create as many task objects as your program needs
begin
-- whatever logic is required in your Main procedure
if some_condition then
Abort_Task (Current_Task);
end if;
end Main;
and a GNAT-specific solution, also OK with tasks:
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.OS_Lib;
procedure Stopping is
procedure P is
begin
GNAT.OS_Lib.OS_Exit (0);
end P;
begin
Put_Line ("starting");
P;
Put_Line ("shouldn't have got here");
end Stopping;
if variable_name >1 then
raise PROGRAM_ERROR with "Aborted because ...";
end if;
will do what you ask. Whether that's what you want is another matter, you haven't given us enough context to guess at that.
The "abort" statement might also be usable, but its normal role is terminating tasks within a multi-tasking program.
Raising an exception is probably easiest, and if you don't like the standard ones, you can always declare your own. With an exception you can also do any tidying up (such as closing files if you need to) in your own exception handler. See the Wikibook for more details.
So when playing with access types on an Ada compiler which turns out to be Ada 2005, I try the following classic example:
type Node is record
next: access Node;
end record;
function reverselist(input: access Node) return access Node is
result: access Node := null;
this: access Node := input;
next: access Node := null;
begin
while this /= null loop
next := this.next;
this.next := result; -- [*]
result := this;
this := next;
end loop;
return result; -- [*]
end;
The two starred lines produce compilation errors because Ada 2005's analysis thinks I might be leaking a local pointer. (I know that Ada 2012 has better analysis and will accept this. However, I don't have an Ada 2012 compiler.)
Okay, so this can be easily solved by using a named pool access instead of the anonymous access Node; by using a pool access I tell the compiler that the pointers can't be referring to stack objects. That works fine.
However, then I tried using a named general access:
type Node;
type List is access Node;
type Node is record
next: List;
end record;
function reverselist(input: List) return access Node is
result: List := null;
this: List := input;
next: List := null;
begin
while this /= null loop
next := this.next;
this.next := result;
result := this;
this := next;
end loop;
return result;
end;
General access types can point at stack objects as well as heap objects; so why doesn't the compiler reject the second example for the same reasons that it rejected the first?
(I was also slightly surprised that anonymous access integer variables seem to end up with general access semantics. Why don't I have to use access all integer for anonymous general accesses?)
Although in general a general access type can point at non-heap objects (both global and stack), there are rules that would prevent a List from pointing to the stack. In this case, since List is not declared inside any subprogram, it cannot be made to point to a stack variable:
function reverselist(input: List) return access Node is
result: List := null;
this: List := input;
next: List := null;
Dummy : aliased Node;
begin
result := Dummy'Access; -- a compile-time error would occur at this point
while this /= null loop
next := this.next;
this.next := result;
result := this;
this := next;
end loop;
return result;
end;
Since the rules "ensure" that a List can never point to a stack variable, there's no need for the compiler to reject any of the other statements. (I put "ensure" in quotes because you could use 'Unchecked_Access to get around them, as well as Unchecked_Conversion or a number of other ways to get around the type system.)
If an access type is declared inside a subprogram, it can point to stack variables inside that subprogram. This is because no objects of that access type can be declared outside the subprogram and therefore it's not possible (barring unchecked tricks) for any object of this type to live after the subprogram is completed. It can also point to globals, or to heap objects. But it can't point to stack variables in a nested subprogram.
procedure Proc is
type Node is ...
type Acc is access all Node;
N1 : aliased Node;
procedure Nested_Proc is
N2 : aliased Node;
X : Acc;
begin
X := N1'Access; -- legal
X := N2'Access; -- illegal. N2 is too deep for this access type.
end;
So it's at the point where 'Access is used that the compiler makes sure that dangling references to no-longer-existing variables can't be created.
All this is governed by the accessibility rules, which are clearly spelled out in RM 3.10.2. (I'm kidding. 3.10.2 is very difficult to understand and tends to produce migraines and borderline insanity in those who try to read it.)
Edit: To follow up on your comment: Basically, I don't think the compiler is doing any sort of "robust analysis". Most of the rules are actually simpler than I made it sound. In Ada 2005, most access types, including most anonymous ones, have a "level" that depend on where the type is declared. If an access object's type is level L, it can't take an access value whose level is "deeper" (more nested) than L. Each anonymous access declares a new type, whose level usually depends on where it's declared. In your example that uses anonymous access types, the type of the next record field is library level since it's outside any procedure; the type of the result is deeper than that since it's inside a procedure. this.next := result is illegal because result, being deeper, could point to a stack variable, and this.next has a shallower level and thus this isn't allowed. For the named access type case, this.next := result is legal because result is just as shallow as the next field, and result wouldn't be allowed to point to a stack variable in the first place. In Ada 2012, I think it's different because the anonymous access objects have to keep track at runtime of the level of the thing they're point to. So this.next := result is legal, but (I think) will raise an exception at runtime if result points to a stack variable. In Ada 2012, these access objects will need some extra data to allow them to do this check; in Ada 2005, they could all be just simple pointers. (I could be wrong about some of the Ada 2012 changes.) But hopefully that isn't too complicated. The complications in 3.10.2 have to do with anonymous access parameters, anonymous access discriminants, and some other special cases that your example doesn't have anything to do with.
One solution is to restructure the code a bit; using an extended-return might do it for you:
type Node is record
next: access Node;
end record;
function reverse_list(input: access Node) return access Node is
this: access Node := input;
next: access Node := null;
begin
Return result: access Node := null do
while this /= null loop
next := this.next;
this.next := result;
result := this;
this := next;
end loop;
end return;
end reverse_list;
While accessibility-checks can get frustrating, I have an overall good opinion of them: we do not want dangling pointers.