I am a newbie in Ada programming language and I am working on concurrent programming, but I am having a problem with one implementation. This might be very dummy question. The code is:
type status is array(1..6) of boolean; --boolean values for each track
track_available :status:=(others=>true); --true if track is available
protected track_handler is
entry track_req(n:in track_part_type); --n is track number
entry track_rel(n:in track_part_type); --n is track number
end track_handler;
protected body track_handler is
--implement entries
entry track_req(n: in track_part_type) when track_available(n) is --here where the error occurs
begin
req(n);
end track_req;
entry track_rel(n: in track_part_type) when track_available(n) is
begin
rel(n);
end track_rel;
end track_handler;
procedure req(nr : track_part_type) is
begin
--null;
track_available(nr):=false;
end req;
procedure rel(nr : track_part_type) is
begin
--null;
track_available(nr):=true;
end rel;
Here I get a compilation error for "when track_available(n)" statement saying that "n is undefined". I think variable n is out of scope, but I also need to check if the n'th index of the array is true or false. How can I overcome this problem?
Thank you.
You can't actually use an entry's parameters in its own guard. You got that much, I gather.
The way guards work, all of them are evaluated before the wait starts, and only the ones that are active at that time will be available. They don't get periodicly re-evaluated or dynamicaly read or anything.
This means it will be tough to get the logic for your guards right, unless you write your code so that only other entries in your protected object modify the guards. If you want to use some data from outside of your protected object to control its behavior, you will probably need to use some mechanisim other than guards to do it. Like check just inside the entry and exit immediately or something.
There is one possibility for what you are trying to do though: Entry families. You should be able to use an entry family index in a guard.
The spec would change to:
entry track_req(track_part_type);
entry track_rel(track_part_type);
And the body would change to
entry track_req(for n in track_part_type) when track_available(n) is
begin
req(n);
end track_req;
entry track_rel(for n in track_part_type) when track_available(n) is
begin
rel(n);
end track_rel;
end track_handler;
In the code below you are trying to use track_available(n), before it has been fully defined by (n: in track_part_type).
entry track_req(n: in track_part_type) when track_available(n) is
See also http://en.wikibooks.org/wiki/Ada_Programming/Tasking#Protected_types
NWS
Related
I am converting a Delphi app from using a TTreeView to using a TVirtualStringTree; The node data is held in TItemData records in a TList.
type
TItemData = record
idName: string;
end;
PItemData = ^TItemData
TMyForm = class(TForm)
...
private
itemData: TList<TItemData>;
..
end;
I wanted to get the displayed tree up and running in the most straightforward way possible, and then gradually convert the app little by little as I got to understand how to use the VirtualStringTree. So, I have a buildTreeFromItemData() method, which iterates through the TList elements and creates child nodes in the VirtualStringTree. I [tried to] pass a pointer to each TItemData record in each call to VST.addChild() which would then be dereferenced in vstGetText(), something like this:
procedure buildTreeFromItemData;
var
i: integer;
idA: TItemData;
begin
for i := 0 to itemData.count - 1 do begin
idA := itemData[i];
vst.addChild(NIL, #idA);
end;
end;
Dereference the pointer:
procedure TMyForm.vstGetData(...);
var
idB: TItemData;
begin
idB := node.getData^;
CellText := idB.idName;
end;
It quickly became apparent that no matter how many different ways I tried to code this, e.g. #itemData[i], the only times my code compiled every vst node was actually getting the address of the idA local variable, and every tree node was pointing to the most recent TItemData record pointed to by idA. I was then getting access violations in vstGetText() once buildTreeFromItemData() had completed and the local idA variable went out of scope, i.e. every node's data pointer in vst was now invalid.
Most of my attempts to somehow deference idA and get at the address location of the TItemData stored in idA generated an "invalid typecast" from the Delphi syntax checker, let alone the compiler.
At one point I tried something like this:
ptr1^ := #idA;
I have no idea what that actually means to the Delphi compiler. I know what I wanted it to mean: I wanted it to mean "set ptr1 to the [dereferened] address stored at the address of the idA local variable". To my surprise, it compiled but went bang as soon as the debugger hit that statement. (What does the compiler think "ptr1^ := " means?)
Eventually I hit upon the idea of typecasting idA to a TObject; at least then, my thinking went, the compiler would know we were at least in the realms of dereferencing and might actually let me, eventually, get to the pointer I really needed to pass to vst.addChild().
After much experimentation, and many more "invalid typecast"s, unbelievably [at least to me] the following code works!.....
procedure buildTreeFromItemData;
var
i: integer;
idA: TItemData;
myObj: TObject;
ptr1: pointer;
ptr2: PItemData;
begin
for i := 0 to itemData.count - 1 do begin
idA := itemData[i];
myObj := TObject(#idA);
ptr1 := pointer(myObj)
ptr2 := PItemData(ptr1^);
vst.addChild(NIL, ptr2);
end;
end;
ptr2 is now so far removed, syntactically and semantically, from idA, that the compiler finally allows the dereference in PItemData(ptr1^), although it only allowed it after I added the PItemData(...) typecast.
I don't even have to dereference this pointer in vstGetText!...
procedure TMyForm.vstGetText(...);
var
idB: PItemData;
begin
idB := PItemData(node.getData);
CellText := idB.idName;
end;
The tree displays perfectly and the access violations are gone. (NB. The actual code in buildTreeFromItemData() is a lot more involved and creates child nodes of child nodes to create a complex tree structure several levels deep.)
Although I eventually found a solution at gone 1am this morning after a lot of trial and error, I find it difficult to believe that my jiggerypokery with the local variable is really necessary for something so simple. So my question is this: what is the correct Delphi syntax for getting the address of my TItemData record stored in a plain "idA: TItemData;" local variable?
(I think this is my first ever question to stackoverflow; I hope I have formulated it well enough. I've kept the code to the absolute bare bones necessary to illustrate the issue and I wasn't able to completely reproduce the exact experimentation code I went through. The solution in the final two code blocks, though, is my working code. If I can improve how I've formulated the question and the explanation to meet stackoverflow's stringent standards, please let me know.)
what is the correct Delphi syntax for getting the address of my TItemData record stored in a plain "idA: TItemData;" local variable?
Well... That one is simple. You do it like this : #idA.
The issue here is that it is NOT what you want to do. You want to have the address of the TItemData in your list (idA is merely a copy of the record in itemData).
To get the address of a value inside of a TList<T>, you can't use property Items[Index: Integer]: T of TList<T> as it will only return you a copy of the value. You need to use property List: arrayofT which will give you direct access the underlying array in which the values are stored, and then you can get the address with : #itemData.List[I].
That being said, it is not something I would recommend. There is no guarantees how long that pointer will remain valid. There is a lot of operations on the list that might render that address invalid, or make it point to the wrong TItemData. If itemData is immutable by the time you acquire the pointer, it's should be ok. Otherwise, it would be way better to allocate new TItemData like described by IVO GELOV in his answer.
Answer to comment :
is there no legit Delphi syntax to achieve what I managed to do?
You did not manage to do what you think you did.
idA := itemData[i]; //Copy the value from the list
myObj := TObject(#idA); //Take the address of iDA and pretend it's a TObject
ptr1 := pointer(myObj) //Now, pretend my TObject is a Pointer
ptr2 := PItemData(ptr1^); //Now, pretend ptr1 is pointing to a PItemData.
//I didn't test it, but I'm pretty sure you could have just written `ptr2 := PItemData((#iDA)^)`
vst.addChild(NIL, ptr2);
So what does this code do? The "main event" here is ptr2 := PItemData(ptr1^). It takes the address of idA, take the first PointerSize(For simplicity, I'll assume 32 bits going forward) byte at that address and pretend it's a PItemData. What are the first 32 bit of TItemData? A string, more precisely idName. Maybe it will help you understand to consider that #idA = #idA.IdName.
So, in other words, vst.addChild(NIL, ptr2); is the same as vst.addChild(NIL, PChar(idA.idName)); or vst.addChild(NIL, #idA.idName[1]); (except for empty string... but I digress). So, what you add in the vst is not the address of the record in itemData, it's the address of the first character of the string idA.idName.
But, your confusion is probably coming from believing records are reference types. They are not, they are value types.
The idea of TVirtualTree is to store your data inside the nodes. TVirtualTree will reserve memory for your data and that's why you need to tell the tree how big is your data.
So, when your form is created (inside OnCreate handler) you should set the NodeDataSize property of your VirtualTree:
procedure TmyForm.TntFormCreate(Sender: TObject);
begin
inherited;
myVirtualTree.NodeDataSize:=SizeOf(TItemData);
end;
You should also handle the OnFreeNode event from your VirtualTree:
procedure TmyForm.myVirtualTreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
Data:PItemData;
begin
Data:=Sender.GetNodeData(Node);
if Assigned(Data) then Finalize(Data^);
end;
When you want to create a new node in the tree:
procedure TmyForm.CreateNewNode(data:TItemData);
var
node: PItemData;
P: PVirtualNode;
begin
with myVirtualTree do
begin
P:=AddChild(Nil);
node:=GetNodeData(P);
node^:=data;
// ReinitNode is very important - to update InternalNode precomputed
// text width. Otherwise node can not be properly selected if
// FullRowSelect is FALSE
ReinitNode(P,False);
end;
end;
You will also need to handle other events from TVirtualTree like OnGetText, onPaintText, onCompareNodes, onIncrementalSearch, onDblClick, onGetHint, etc.
I am developing a quizing game in Delphi and I would like to have a timer so that players don´t have unlimited time to answer the questions. I am using the function "Time" to get the current time but I don´t know how to convert it to something like an integer so that when let´s say 10 seconds have passed the player loses it´s chance. It would look like something like this:
Var
CurrentTime,Aux:TDateTime;
Begin
CurrentTime:=Time; //Current Time is assigned to a global variable.
Aux:=CurrentTime;
While (Aux-10000<=CurrentTime) do
Begin
if (Answer:=True) then //If the answer is already given by the player we break the while loop
Break;
Aux:=Time; //We refresh the auxilary variable
if (Aux-10000>=CurrentTime) then //We check if 10 seconds have passed
Begin
showmessage('You have taken too much time, your turn is lost');
exit; //We leave the script
end;
end;
end;
The problem is I can´t do arithmetic operations in DateTimes, as far as I know, So I need a different method for comparing the 2 different time instances. Any help would be appreciated, thanks!
TDate, TTime, and TDateTime are implemented using floating-point numbers, so you can perform arithmetic operations on them.
But you really shouldn't, in this case. The DateUtils unit has many functions for working with date/time values, eg:
uses
..., DateUtils;
var
StartTime, Aux: TDateTime;
begin
StartTime := Time();
Aux := StartTime;
...
while (not Answer) and (MillisecondsBetween(Aux, StartTime) < 10000) do
begin
Sleep(0);
Aux := Time();
end;
if (not Answer) then
begin
ShowMessage('You have taken too much time, your turn is lost');
Exit; //We leave the script
end;
...
end;
Note that this is not really a good use for TDateTime. Your calculations are relying on the system clock in local time being accurate and unchanging, but it can be changed dynamically while your code is running (user updates, network updates, daylight saving time change, etc), throwing off the results.
Consider using TStopWatch instead. It is intended for exactly this kind of use-case (determining elapsed time between actions), eg:
uses
..., System.Diagnostics;
var
SW: TStopWatch;
begin
SW := TStopWatch.StartNew;
...
while (not Answer) and (SW.ElapsedMilliseconds < 10000) do
Sleep(0);
if (not Answer) then
begin
ShowMessage('You have taken too much time, your turn is lost');
Exit; //We leave the script
end;
...
end;
Or, you could use TEvent instead, and have the answer signal the event when ready, eg:
uses
..., SyncObjs;
var
AnsweredEvent: TEvent;
...
// when the answer is submitted:
AnsweredEvent.SetEvent;
...
begin
AnsweredEvent.ResetEvent;
...
if AnsweredEvent.WaitFor(10000) <> wrSignaled then
begin
ShowMessage('You have taken too much time, your turn is lost');
Exit; //We leave the script
end;
end;
initialization
AnsweredEvent := TEvent.Create;
finalization
AnsweredEvent.Free;
I have written a few applications like this, using a TTimer. The timer's interval is set to 1000, which is equivalent to 1 second (you can use a different value); every time the timer's OnTimer event executes, a global variable is incremented which is then checked against the time limit (10 seconds?); if the variable equals this limit then first the timer is stopped, then the code performs whatever is necessary to transfer to the next person, or next question.
There should be similar code that executes when the person enters an answer as this code too needs to first save the answer then transfers to the next person. This portion should also stop the timer.
The 'show next question' part should restart the timer and reset the global variable only after the next question has been displayed, as it might take some time for it to be fetched.
I am trying to display a success/error message with a dynamic action but nothing is showing up.
Here is my code for the true condition of my action.
declare
v_complete number;
begin
select count(task_status) into v_complete from IT_TASK where TASK_STATUS != 3 AND REQUEST_ID = :P32_ID ;
if v_complete > 0 then
apex_application.g_print_success_message := '<span style="color:red">Not all Task are complete!</span>';
rollback;
end if;
if v_complete = 0 then
apex_application.g_print_success_message := '<span style="color:green">All Task are complete!</span>';
rollback;
end if;
end;
However, no message appears after my condition is met.
Can anyone tell me why?
apex_application.g_print_success_message is only used by the Apex engine when rendering the page - after the page has been rendered, any dynamic actions that change it will have no effect.
A simple way you might achieve your goal is to add a display-only item to your page, e.g. P1_RESULT, and in your dynamic action set its value. Your dynamic action could also show and/or hide the display item as needed.
you need to initialize v_complete to 0 when declaring
declare
v_complete number := 0;
begin..
.......
Run the query in sqlplus or sqldeveloper and see the results. Add a third condition for v_complete < 0 with a different message. Also, turn on debugging and see if it's getting to the true condition. Also, best practice is to avoid putting anonymous PL/SQL blocks into APEX apps. This should be in a stored function and called to enhance reuse and maintenance.
I am working on a "classic" ASP application with a SQL Server 2000 database.
We have a stored procedure (let's call it SP0) that calls other stored procedures (let's say SP0.1, SP0.2 ...) which themselves call another stored procedure called SPX.
All those procedures generate errors when something goes wrong using RAISERROR().
We want to be able to launch SP0 with a parameter #errorsInResultSet which will change its behaviour : instead of "re-raising" the errors as it does so far, each sub-procedure will log the errors in a temporary table #detectedProblems and return it at the end.
Adding errors to the temporary table is not a problem, but I can not figure out how to ignore the errors generated by the nested stored procedures.
I have done this so far :
EXEC #rc = [SP0.1] #errorsAsResultSet = #errorsAsResultSet
IF (0 <> ##ERROR) OR (0 <> #rc)
BEGIN
IF (#errorsAsResultSet <> 0x1)
BEGIN
RAISERROR('SP0.1: Error for table Tests in db %s.%s', 16, 1, ##SERVERNAME, #db)
END
GOTO FAILURE
END
This works fine, but it still generate errors from the lowest SPX, which prevent it from being executed by ADO in classic ASP.
How can I ignore the errors ?
If you're happy that the errors are being logged and it's safe to continue, you can use ON ERROR RESUME NEXT on the line before the SP call. This will prevent the page from throwing errors.
To turn back on errors later in the page, you can use ON ERROR GOTO 0
In the end, it looks like there is no way to "hide" messages generated by PRINT or RAISERROR statements in SP0.1, SP0.2 from the calling Stored Procedure, which means that the execution is always interpreted as "erroneous" by ASP.
In the end, I rewrote a new Stored Procedure with a special parameter to configure how to report errors.
When I call this function, everything works, as long as I don't try to recursively call the function again. In other words if I uncomment the line:
GetChilds rsData("AcctID"), intLevel + 1
Then the function breaks.
<%
Function GetChilds(ParentID, intLevel)
Set rsData= Server.CreateObject("ADODB.Recordset")
sSQL = "SELECT AcctID, ParentID FROM Accounts WHERE ParentID='" & ParentID &"'"
rsData.Open sSQL, conDB, adOpenKeyset, adLockOptimistic
If IsRSEmpty(rsData) Then
Response.Write("Empty")
Else
Do Until rsData.EOF
Response.Write rsData("AcctID") & "<br />"
'GetChilds rsData("AcctID"), intLevel + 1
rsData.MoveNext
Loop
End If
rsData.close: set rsData = nothing
End Function
Call GetChilds(1,0)
%>
*Edited after feedback
Thanks everyone,
Other than the usual error:
Error Type: (0x80020009) Exception occurred.
I wasn't sure what was causing the problems. I understand that is probably due to a couple of factors.
Not closing the connection and attempting to re-open the same connection.
To many concurrent connections to the database.
The database content is as follows:
AcctID | ParentID
1 Null
2 1
3 1
4 2
5 2
6 3
7 4
The idea is so that I can have a Master Account with Child Accounts, and those Child Accounts can have Child Accounts of their Own. Eventually there will be Another Master Account with a ParentID of Null that will have childs of its own. With that in mind, am I going about this the correct way?
Thanks for the quick responses.
Thanks everyone,
Other than the usual error:
Error Type: (0x80020009) Exception
occurred.
I wasn't sure what was causing the problems. I understand that is probably due to a couple of factors.
Not closing the connection and attempting to re-open the same connection.
To many concurrent connections to the database.
The database content is as follows:
AcctID | ParentID
1 Null
2 1
3 1
4 2
5 2
6 3
7 4
The idea is so that I can have a Master Account with Child Accounts, and those Child Accounts can have Child Accounts of their Own. Eventually there will be Another Master Account with a ParentID of Null that will have childs of its own. With that in mind, am I going about this the correct way?
Thanks for the quick responses.
Look like it fails because your connection is still busy serving the RecordSet from the previous call.
One option is to use a fresh connection for each call. The danger there is that you'll quickly run out of connections if you recurse too many times.
Another option is to read the contents of each RecordSet into a disconnected collection: (Dictionary, Array, etc) so you can close the connection right away. Then iterate over the disconnected collection.
If you're using SQL Server 2005 or later there's an even better option. You can use a CTE (common table expression) to write a recursive sql query. Then you can move everything to the database and you only need to execute one query.
Some other notes:
ID fields are normally ints, so you shouldn't encase them in ' characters in the sql string.
Finally, this code is probably okay because I doubt the user is allowed to input an id number directly. However, the dynamic sql technique used is very dangerous and should generally be avoided. Use query parameters instead to prevent sql injection.
I'm not too worried about not using intLevel for anything. Looking at the code this is obviously an early version, and intLevel can be used later to determine something like indentation or the class name used when styling an element.
Running out of SQL Connections?
You are dealing with so many layers there (Response.Write for the client, the ASP for the server, and the database) that its not surprising that there are problems.
Perhaps you can post some details about the error?
hard to tell without more description of how it breaks, but you are not using intLevel for anything.
How does it break?
My guess is that after a certain number of recursions you're probably getting a Stack Overflow (ironic) because you're not allocating too many RecordSets.
In each call you open a new connection to the database and you don't close it before opening a new one.
Not that this is actually a solution to the recursion issue, but it might be better for you to work out an SQL statement that returns all the information in a hierarchical format, rather than making recursive calls to your database.
Come to think of it though, it may be because you have too many concurrent db connections. You continually open, but aren't going to start closing until your pulling out of your recursive loop.
try declaring the variables as local using a DIM statement within the function definition:
Function GetChilds(ParentID, intLevel)
Dim rsData, sSQL
Set ...
Edit: Ok, I try to be more explicit.
My understanding is that since rsData is not declared by DIM, it is not a local variable, but a global var. Therefore, if you loop through the WHILE statement, you reach the .Eof of the inner-most rsData recordset. You return from the recursive function call, and the next step is again a rsData.MoveNext, which fails.
Please correct me if rsData is indeed local.
If you need recursion such as this I would personally put the recursion into a stored procedure and handle that processing on the database side in order to avoid opening multiple connections. If you are using mssql2005 look into something called Common Table Expressions (CTE), they make recursion easy. There are other ways to implement recursion with other RDBMS's.
Based on the sugestions I will atempt to move the query into a CTE (common table expression) when I find a good tutorial on how to do that. For now and as a quick and dirty fix, I have changed the code as follows:
Function GetChilds(ParentID, intLevel)
'Open my Database Connection and Query the current Parent ID
Set rsData= Server.CreateObject("ADODB.Recordset")
sSQL = "SELECT AcctID, ParentID FROM Accounts WHERE ParentID='" & ParentID &"'"
rsData.Open sSQL, conDB, adOpenKeyset, adLockOptimistic
'If the Record Set is not empty continue
If Not IsRSEmpty(rsData) Then
Dim myAccts()
ReDim myAccts(rsData.RecordCount)
Dim i
i = 0
Do Until rsData.EOF
Response.Write "Account ID: " & rsData("AcctID") & " ParentID: " & rsData("ParentID") & "<br />"
'Add the Childs of the current Parent ID to an array.
myAccts(i) = rsData("AcctID")
i = i + 1
rsData.MoveNext
Loop
'Close the SQL connection and get it ready for reopen. (I know not the best way but hey I am just learning this stuff)
rsData.close: set rsData = nothing
'For each Child found in the previous query, now lets get their childs.
For i = 0 To UBound(myAccts)
Call GetChilds(myAccts(i), intLevel + 1)
Next
End If
End Function
Call GetChilds(1,0)
I have working code with the same scenario.
I use a clientside cursor
...
rsData.CursorLocation = adUseClient
rsData.Open sSQL, conDB, adOpenKeyset, adLockOptimistic
rsData.ActiveConnectcion = Nothing
...
as pointed out in other responses, this is not very efficient, I use it only in an admin interface where the code is called infrequently and speed is not as critical.
I would not use such a recursive process in a regular web page.
Either rework the code to get all data in one call from the database, or make the call once and save it to a local array and save the array in an application variable.