I was wondering if there is a clearer statement then
if not attached foo then
create foo
end
if attached foo as l_foo then
l_foo.bark
end
as
if not attached foo then
create foo
foo.bark
else
foo.bark
end
would repeat the foo.bark and obviously I want to avoid it... and even the last statement won't compile with void-safety as foo on else could be void...
To avoid code duplication and multiple tests, the following code could be used:
l_foo := foo
if not attached l_foo then
create l_foo
foo := l_foo
end
l_foo.bark
Related
Why am I getting a syntax error on this simple perform call
create or replace function foo ()
returns void
as $$
begin
end;
$$ language 'plpgsql';
perform * from foo ();
I tested it online at ExtendsClass
PERFORM is a PL/pgSQL statement, not a SQL one. This means it can only be used between the BEGIN and END of a function definition. See below, where I call bar() from foo() using PERFORM.
create or replace function bar ()
returns void
as $$
begin
RAISE NOTICE 'bar() ran';
end;
$$ language 'plpgsql';
create or replace function foo ()
returns void
as $$
begin
perform bar();
end;
$$ language 'plpgsql';
The SQL fiddle site you've linked doesn't show stderr, but if you paste the above into psql and then select * from foo();, you'll see that bar() ran.
testdb=# select * from foo();
NOTICE: bar() ran
foo
-----
(1 row)
I have a problem with TStringLists in Lazarus. I have an array called 'trans' of records called 'TTrans' which contain, among other things, TStringList called 'meebetalers'. So when I need to know for example the amount of lines in that StringList I would have to write this right?
trans[i].meebetalers.Count;
Anyways, I first create a stringlist and put the selected strings from a checklistbox in it, and that works (i.e. the program returns 3 when I ask for the Count, which is correct).
In this piece of code I add values to the StringList:
slmeebetalers := TStringList.Create;
for i:= 0 to Form6.CLBox.Count-1 do begin
if Form6.CLBox.Checked[i] then begin
slmeebetalers.Add(Form6.CLBox.Items[i]);
end;
end;
Then I put the stringlist a procedure, and in that procedure I assign my first created StringList to the stringlist I mentionned before (trans[i].meebetalers), see my piece of code next.
Unit6.VoegTransToe(Form6.TransNaam.Text,
Form6.TrComboBox.Text,
bedrag,
slmeebetalers,
Form6.CalendarDialog1.Date);
But when I then ask for the count, it returns 0.
procedure VoegTransToe(naam, betaalpers: string; bedrag: currency;
meebetalers: TStringList; datum: TDateTime);
begin
aantaltrans:= aantaltrans+1;
trans[aantaltrans].naam:=naam;
trans[aantaltrans].pers.naam:=betaalpers;
trans[aantaltrans].bedrag:=bedrag;
trans[aantaltrans].datum:=datum;
meebetalers:= TStringList.Create;
trans[aantaltrans].meebetalers:= TStringList.Create;
trans[aantaltrans].meebetalers.Assign(meebetalers);
meebetalers.Free;
//trans[aantaltrans].meebetalers.Free;
end;
note The difference in name of the variable is because they are in different units
With this code I don't get an error, but it returns 0. When I say //meebetalers.Free; the same happens.
But when I add //trans[aantaltrans].meebetalers.Free; I don't get an error while compiling, but when I call the procedure. Then I get this error:
Project project1 raised exception class 'External: SIGSEGV'.
I think there is something wrong with the Create and Free function, but I don't know what. When I implement the try...finally...end it returns the same error. Can anybody help me?
The problem is that your VoegTransToe() procedure is ignoring the populated TStringList object that is passed in via its meebetalers parameter. You are resetting meebetalers to point at a newly created empty TStringList object just before assigning meebetalers to trans[aantaltrans].meebetalers.
procedure VoegTransToe(naam, betaalpers: string; bedrag: currency;
meebetalers: TStringList; datum: TDateTime);
begin
aantaltrans:= aantaltrans+1;
trans[aantaltrans].naam:=naam;
trans[aantaltrans].pers.naam:=betaalpers;
trans[aantaltrans].bedrag:=bedrag;
trans[aantaltrans].datum:=datum;
// meebetalers:= TStringList.Create; // <-- GET RID OF THIS!
trans[aantaltrans].meebetalers:= TStringList.Create;
trans[aantaltrans].meebetalers.Assign(meebetalers);
//meebetalers.Free; // <-- AND THIS!
end;
Don't forget to Free() the input TStringList object when you are done using it:
slmeebetalers := TStringList.Create;
try
for i := 0 to Form6.CLBox.Count-1 do begin
if Form6.CLBox.Checked[i] then begin
slmeebetalers.Add(Form6.CLBox.Items[i]);
end;
end;
Unit6.VoegTransToe(..., slmeebetalers, ...);
finally
slmeebetalers.Free;
end;
What is a good way to link an indexed task to a corresponding indexed protected type in SPARK?
For specifics, consider this setup:
subtype Thread_Range is Natural range 1..n;
protected type P is ... end P;
p: array(Thread_Range) of P;
For each p(i) I would like a task t(i) that monitors p(i) and, when it's ready, processes it. I can make this work pretty easily in Ada, but SPARK w/Ravenscar is more demanding. I've tried two approaches that appear to work fine when I run them:
Give T an Integer discriminant, then instantiate a T(i); for each i, but this grows burdensome with not-very-large i.
task type T(which: Integer);
t1: T(1);
t2: T(2);
...
Add an is_not_monitored function and a set_monitor procedure to P. Create an array of tasks without discriminant. When t(i) begins, it assigns itself to monitor the first p(j) it finds that hasn't already been assigned a monitor.
task type T;
task body T is
which: Integer;
available: Boolean;
begin
for i in Thread_Range loop
available := p(i).is_not_monitored;
if available then
p(i).set_monitor;
which := i;
end if;
end loop;
-- what the task does with p(i) follows
end T;
t: array(Thread_Range) of T;
I like the second one better, but not by much. In any case, SPARK "Prove" grumbles about potential data races, and I can see why (though I'm not sure it's actually due to this).
Hence the question.
This doesn’t cause gnatprove to choke.
And I think the main difference from your option 2 is that Claim checks whether the claim is possible and, if so, performs the claim in one protected call.
But I don’t quite see how to prove that the loop Claim in T exits with Ps (J) being claimed. I tried putting an assertion after the loop, but couldn’t get it to prove.
protected type P is
procedure Claim (Succeeded : out Boolean);
private
Claimed : Boolean := False;
end P;
subtype Thread_Range is Integer range 1 .. 2;
Ps : array (Thread_Range) of P;
Ts : array (Thread_Range) of T;
task body T is
Which : Integer;
begin
Claim:
for J in Thread_Range loop
declare
Claimed : Boolean;
begin
Ps (J).Claim (Succeeded => Claimed);
if Claimed then
Which := J;
exit Claim;
end if;
end;
end loop Claim;
loop -- having a loop keeps gnatprove quiet
delay until Ada.Real_Time.Time_Last;
end loop;
end T;
protected body P is
procedure Claim (Succeeded : out Boolean) is
begin
if not Claimed then
Claimed := True;
Succeeded := True;
else
Succeeded := False;
end if;
end Claim;
end P;
After out-of-band discussions with John, we’ve found that this postcondition can be proved:
procedure Claim (Succeeded : out Boolean)
with
Post =>
(Is_Claimed'Old or (Succeeded and Is_Claimed))
or
(not Succeeded and Is_Claimed);
Note that it’s not P’Old.Is_Claimed, mainly because ’Old requires a copy, and P is limited (because it’s a protected type).
We also found several alternative formulations that prove in GPL 2017 but not in CE 2018: for example,
(Is_Claimed
and
(Is_Claimed'Old xor Succeeded)
I'm not an expert in this, but it seems that you cannot show SPARK that there's a one-to-one relation between a task instance and a protected object instance unless you reference that protected object instance explicitly from a task instance. This is in particular to make SPARK prove that only one task will queue on the entry of a protected object; the Wait entry in the code below). Therefore (and while this might not be exactly what you're looking for), I could only solve the problem of connecting tasks and protected objects, and at the same time having a monitor functionality, by using a generic package that can be instantiated multiple times. This proves in GNAT CE 2018:
generic
package Generic_Worker with SPARK_Mode is
task T;
protected P is
entry Wait;
procedure Trigger;
private
Triggered : Boolean := False;
end P;
end Generic_Worker;
with body:
package body Generic_Worker with SPARK_Mode is
task body T is
begin
loop -- Ravenscar: Tasks must not terminate.
P.Wait;
end loop;
end T;
protected body P is
entry Wait when Triggered is
begin
Triggered := False;
-- Do some work.
end Wait;
procedure Trigger is
begin
Triggered := True;
end Trigger;
end P;
end Generic_Worker;
and instantiations:
with Generic_Worker;
pragma Elaborate_All (Generic_Worker);
package Workers with SPARK_Mode is
package Worker_0 is new Generic_Worker;
package Worker_1 is new Generic_Worker;
package Worker_2 is new Generic_Worker;
package Worker_3 is new Generic_Worker;
package Worker_4 is new Generic_Worker;
end Workers;
I'm working on a multithreading project and i have one array of tasks, let's call it A and one array of protected, let's call it B.
Now every element of A at some point will want to access entry from one of the elements of B. Is there a way to iterate quickly through B's and find accesible one?
I was browsing some resources avalaible online and found only
select
call entry;
or
delay;
which won't do the job.
Is there a way to do that that i'm not aware of?
Thanks in advance!
EDIT
So i got really excited about that select else statements and tried it out, unfortunately it still doesnt work, if I try it this way - using Mr. Simon Wright's code sample to simulate effect i need, the
else
part of code never gets executed, they (the taskArray elements) all think they can acces Call_Me and get stuck in the queue.
How can i solve this issue? I also tried using 'Count thing, but it somehow always ended up being 0.
with Ada.Text_IO; use Ada.Text_IO;
procedure Array_Of_POs is
protected type PO is
entry Call_Me;
private
Callable : Boolean := True; --changed
end PO;
protected body PO is
entry Call_Me when Callable is
begin
Callable := False; --added
Put_Line("Doin stuff");
delay 1.0;
Callable := True;
end Call_Me;
end PO;
POs : array (1 .. 3) of PO;
Success : Boolean := False;
task type Test; --added
task body Test is
begin
for J in POs'Range loop -- '
select
POs (J).Call_Me;
Success := True;
else
Put_Line("I never get displayed!"); --added
end select;
end loop;
Put_Line ((if Success
then "succeeded, oh dear"
else "didn't succeed, good"));
end Test;
testArray : array (1..3) of Test;
end Array_Of_POs;
You could try finding an entry E whose Count attribute (E’Count, ARM 9.9(5)) is zero; but this is going to result in race conditions, since another task could sneak in between your checking the count and your making the call. And see the note at (7), ibid.
You need a conditional entry call, as in ARM 9.7.3.
It would look something like
with Ada.Text_IO; use Ada.Text_IO;
procedure Array_Of_POs is
protected type PO is
entry Call_Me;
private
Callable : Boolean := False;
end PO;
protected body PO is
entry Call_Me when Callable is
begin
null;
end Call_Me;
end PO;
POs : array (1 .. 3) of PO;
Success : Boolean := False;
begin
for J in POs'Range loop -- '
select
POs (J).Call_Me;
Success := True;
else
null;
end select;
end loop;
Put_Line ((if Success
then "succeeded, oh dear"
else "didn't succeed, good"));
end Array_Of_POs;
In your case, I suspect this construct would be in an outer loop, so you’d need to do something to avoid busy-waiting (on the lines of putting in a delay if not Success, perhaps).
EDIT
This is a response to your edited question.
ARM 9.5.1(8) states that your PO.Call_Me contains a bounded error. In the next paragraph,
If the bounded error is detected, Program_Error is raised. If not detected, the bounded error might result in deadlock or a (nested) protected action on the same target object.
At least GNAT hasn’t done either of those.
The issue is that the body of the entry is executed in the context (thread) of the caller. So what happens is
Test calls POs(1).Call_Me
The call is accepted
Callable is set False
Put_Line and delay are called (still in the context of Test)
Callable is set True
POs(1).Call_Me returns to Test
...
The approach you’ve adopted might work if instead of using an array of POs you used an array of tasks.
Most clean C APIs declare callback as a combination of callback function and a user data. User data is usually void*. WinAPI uses pointer-sized integer (lParam). During making a thick binding a natural desire is to allow Ada 2005 closures to be used in place of C callbacks.
I have a code. It works like a charm on GNAT (GPL 2012, x86-windows is tested at least), but generally there is no guarantee that Run_Closure_Adapter.X variable and Run_Closure.X argument will have the same internal structure.
The question is: is there a proper (standards-compliant) way to do this? Maybe a trick involving tagged types, interfaces or generics. There is at least one way of doing this: running closure executor and closures in different tasks and using rendezvous. But that's too slow.
Closure_Test.adb:
with Closure_Lib; use Closure_Lib;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
procedure Closure_Test is
procedure Closure_Tester is
Local_String : String := "Hello, world!";
procedure Closure is
begin
Put_Line (Local_String);
end Closure;
begin
Run_Closure (Closure'Access);
end Closure_Tester;
procedure Ada_Run_Closure (X : access procedure) is
begin
X.all;
end Ada_Run_Closure;
-- Nested_Closure fills the execution stack with
-- several activation records of Nested_Closure_Tester
-- Having done so (local I = 0) we start a Fibonacci
-- algorithm using Print_Closure access values of
-- different dynamic nesting levels
procedure Nested_Closure_Tester
(I : Integer;
Closure_Runner: access procedure (X : access procedure);
Prev_Closure, Prev_Closure2: access procedure)
is
procedure Print_Closure is
begin
if Prev_Closure /= null and Prev_Closure2 /= null then
Closure_Runner (Prev_Closure);
Closure_Runner (Prev_Closure2);
else
Put (".");
end if;
end Print_Closure;
procedure Nested_Closure is
begin
if I > 0 then
Nested_Closure_Tester (I - 1, Closure_Runner,
Print_Closure'Access, Prev_Closure);
else
Print_Closure;
end if;
end Nested_Closure;
begin
Closure_Runner (Nested_Closure'Access);
end Nested_Closure_Tester;
begin
-- Closure_Tester;
-- I = 6 gives 13 dots
Nested_Closure_Tester(6, Ada_Run_Closure'Access, null, null);
New_Line;
Nested_Closure_Tester(6, Run_Closure'Access, null, null);
end Closure_Test;
Closure_Lib.ads:
with Interfaces.C;
with System;
package Closure_Lib is
procedure Run_Closure (X : access procedure);
private
type Simple_Callback is access procedure(Data : in System.Address);
pragma Convention (C, Simple_Callback);
procedure Run_Callback (X : in Simple_Callback; Data : in System.Address);
pragma Import (C, Run_Callback, "Run_Callback");
procedure Sample_Callback (Data : in System.Address);
pragma Convention (C, Sample_Callback);
end Closure_Lib;
Closure_Lib.adb:
with Interfaces.C;
with System;
with System.Storage_Elements; use System.Storage_Elements;
with Ada.Text_IO; use Ada.Text_IO;
package body Closure_Lib is
procedure Sample_Callback (Data : in System.Address) is
begin
Ada.Text_IO.Put_Line ("Simple_Callback");
end Sample_Callback;
procedure Run_Closure_Adapter (Data : in System.Address);
pragma Convention (C, Run_Closure_Adapter);
procedure Run_Closure_Adapter (Data : in System.Address) is
X : access procedure;
for X'Address use Data;
pragma Import (Ada, X);
X_Size : constant Storage_Count := X'Size / System.Storage_Unit;
begin
-- Put_Line ("Variable access procedure size:" & Storage_Count'Image (X_Size));
X.all;
end Run_Closure_Adapter;
procedure Run_Closure (X : access procedure) is
X_Size : constant Storage_Count := X'Size / System.Storage_Unit;
X_Address : constant System.Address := X'Address;
begin
-- Put_Line ("Anonymous access procedure size:" & Storage_Count'Image (X_Size));
Run_Callback (Run_Closure_Adapter'Access, X_Address);
end Run_Closure;
end Closure_Lib;
closure_executor.c:
typedef void (*Simple_Callback)(void* Data);
void Run_Callback (Simple_Callback X, void* Data) {
(*X)(Data);
}
I think what you're looking for might be met by using a generic (by the way, I don't see how using a task can ensure that data types match?)
Maybe something like
generic
type Client_Data is private;
package Closure_G is
type Closure (<>) is private;
function Create (Proc : access procedure (Parameter : Client_Data);
And_Parameter : Client_Data) return Closure;
procedure Execute (The_Closure : Closure);
private
type Procedure_P is access procedure (Parameter : Client_Data);
type Closure is record
The_Procedure : Procedure_P;
And_Parameter : Client_Data;
end record;
end Closure_G;
When a user calls Execute (A_Closure), the Proc supplied to Create is called with the And_Parameter that was supplied then.
(The type Closure (<>) is private; makes sure tht users can only create a Closure object using the supplied Create.)
The main trouble with this, in your scenario of passing to a C library to be called-back when an event occurs, is that the Closure object is actually maintained by the C library.
Aside from the fact that you don't really need this Ada Closure, there's a potential problem caused by anonymous access-to-subprogram values, which is that the subprogram could be locally declared and have gone out of scope by the time the C library gets round to calling it. This would be Bad News.
In the Ada world, the compiler copes with this problem in two ways. First, you're not allowed to store anonymous access-to-subprogram values (hence the type Procedure_P above). Second, even if you work round this as in
function Create (Proc : access procedure (Parameter : Client_Data);
And_Parameter : Client_Data) return Closure is
begin
return (The_Procedure => Procedure_P'(Proc),
And_Parameter => And_Parameter);
end Create;
the actual 'accessibility levels' are checked at run time; if you get it wrong you'll get a Program_Error.
As an alternative, you might look at how GtkAda handles callbacks from GTK+. As shown in the GtkAda User’s Guide, and discussed in §4.2.2. Connecting via the Gtk.Handlers package,
The Gtk.Marshallers package provides a set of functions that can be used as callbacks directly for GtkAda…A set of To_Marshaller functions is found in every generic package in Gtk.Handlers. They take a single argument, the name of the function you want to call, and return a handler that can be used directly in Connect.
Interaction is an example that instantiates several such handlers and connects the corresponding callback using an access-to-subprogram parameter.