* Re: array from static predicate on enumerated type
@ 2021-03-15 17:53 5% ` Shark8
0 siblings, 0 replies; 26+ results
From: Shark8 @ 2021-03-15 17:53 UTC (permalink / raw)
On Monday, March 15, 2021 at 8:16:58 AM UTC-6, Matt Borchers wrote:
> On Friday, March 12, 2021 at 11:55:54 PM UTC-5, Randy Brukardt wrote:
> > Just don't use them with obsolete data structures. :-)
> I can't tell if you are you being facetious? If not, can you give me some reasons on why you think arrays are obsolete data structures? To me, they remain one of the basic building blocks of all programs.
They are a basic building-block, yes.
But they *AREN'T* maps, nor are they functions... despite the tendency to think of them as nails for your hammer (Array), this really isn't the case... and now that Ada has Ada.Containers.Indefinite_Ordered_Maps it really is an obsolete data-structure for mapping in most cases. (Exceptions exist for things like finite-state machines and virtual-machine instruction-sets where you're working with a uniform/near-uniform collection and/or things like embedded.)
^ permalink raw reply [relevance 5%]
* Re: set_index and and end_of_file with just a stream reference
@ 2021-02-23 17:21 5% ` Shark8
0 siblings, 0 replies; 26+ results
From: Shark8 @ 2021-02-23 17:21 UTC (permalink / raw)
On Saturday, February 20, 2021 at 12:08:16 PM UTC-7, 0012com wrote:
> Okay :-)
> what I wanted is:
> I read an acronyme in the stream file, if good I input the adjacent record type, otherwise I would advance on the stream until the next acronyme with set_index(stream_access, index(stream_access) + composite_type_stream_size) and read the next acronyme (unbounded_string).
> Now I just input both objects and verify the acronyme.
> But I don't like writing an object that maybe won't be used.
Hm, what are your datatypes? Is this ONLY text, or are you able to impose your own structure?
You could have something like this:
-- Instantiated Container Packages.
Package String_Holder is new Ada.Containers.Indefinite_Holders(
Element_Type => String,
"=" => Ada.Strings.Equal_Case_Insensitive
);
Package String_Map is new Ada.Containers.Indefinite_Ordered_Maps(
"<" => Ada.Strings.Less_Case_Insensitive,
"=" => Ada.Strings.Equal_Case_Insensitive,
Key_Type => String,
Element_Type => String
);
-- The heart of the operating program.
With String_Holder, String_Map;
Package Acronyms is
-- Because this is it's own type, you can put other things in the record, like a link to the place that it's defined, if needed.
Type Initialism is new String_Holder.Holder with null record;
Function Expand( Acronym : Initialism ) return String;
Procedure Register( Acronym, Expansion : String );
--...
End Acronyms;
Package Body Acronyms is
Acronym_Map : String_Map.Map;
Procedure Register( Acronym, Expansion : String ) is
Begin
Acronym_Map.Insert( New_Item => Expansion, Key => Acronym );
End Register;
Function Expand( Acronym : Initialism ) return String is
Begin
Return Acronym_Map( Acronym );
Exception
when others => Return Acronym; -- I forget if it's CONSTRAINT_ERROR or ASSERT_ERROR when the element is not present.
End Expand;
End Acronyms;
-- in your main Acronym-Stream package...
-- Text_Soup is a variant record for handling portions of an acronym-expanding string; your main data-structure would probably be an Indefinite_Vector of Text_Soup'Class,
-- you might not need Input or output, depending on your usage, but for automatically expanding the initialism you'd need to use Acronyms.Expand.
Type Text_Soup(<>) is tagged private;
procedure Output(
Stream : not null access Ada.Streams.Root_Stream_Type'Class;
Item : in Text_Soup'Class);
function Input(
Stream : not null access Ada.Streams.Root_Stream_Type'Class)
return Text_Soup'Class;
-- Other public operations.
PRIVATE
For Text_Soup'Class'Input use Input;
For Text_Soup'Class'Output use Output;
Type Text_Soup(Length : Natural) is record
case Length is
when 0 => Acronym : Initialism;
when others => Text : String(1..Length);
end case;
end record;
--...
^ permalink raw reply [relevance 5%]
* Re: Visibility issue
@ 2020-09-17 21:47 4% ` Shark8
0 siblings, 0 replies; 26+ results
From: Shark8 @ 2020-09-17 21:47 UTC (permalink / raw)
On Friday, September 11, 2020 at 4:37:29 AM UTC-6, Daniel wrote:
> Hello,
> I want to use a tagged type as a link to communicate users of a library, in the way to make one part visible to them and also to hide some content that is only needed for the implementing of the library.
Here's how that's normally achieved; I've compiled the following but haven't written a testbed/driver:
-- Daniel.ads
Package Daniel with Pure is
-- Base Interface which all API objects implement.
Type Abstract_Base is interface;
-- All common methods.
Function As_String(Object : Abstract_Base) return String is abstract;
-- All Classwide methods.
Function Print( Object : Abstract_Base'Class ) return String;
-- The Callback type.
Type Callback is access
procedure(Item : in out Abstract_Base'Class);
Private
-- The classwide "Print" returns the given object's As_String result.
Function Print( Object : Abstract_Base'Class ) return String is
(Object.As_String);
End Daniel;
-----------------------------------------------
-- Daniel-Implementation.ads
With
Ada.Finalization,
Ada.Strings.Equal_Case_Insensitive,
Ada.Strings.Less_Case_Insensitive,
Ada.Containers.Indefinite_Ordered_Maps;
Private Package Daniel.Implementation with Preelaborate is
-- Fwd decl.
Type Implementation_Base(Name_Length : Positive) is tagged private;
-- Implementation_Base and its descendents have a Name, that is within the
-- private-portion of the implementation and therefore we need an accessor.
-- Note: Name is unique and case-insensitive.
Function Get_Name(Object: Implementation_Base'Class) Return String;
-- Given a name, this retrieves the object; raises constraint-error if that
-- name is not associated with an object.
Function Make (Name : String) return Implementation_Base'Class;
Function Create(Name : String) return Implementation_Base;
Function "="(Left, Right : Implementation_Base) return Boolean;
Private
-- Full decl. Note, also, that this is hidden from the API package.
Type Implementation_Base(Name_Length : Positive) is
new Ada.Finalization.Controlled with record
Name : String(1..Name_Length);
End record;
-- Finalization; this will remove the registered Name from the object-map.
overriding
procedure Finalize (Object : in out Implementation_Base);
-- Instantiate the package mapping Names to Objects.
Package Name_Map is new Ada.Containers.Indefinite_Ordered_Maps(
Key_Type => String,
Element_Type => Implementation_Base'Class,
"<" => Ada.Strings.Less_Case_Insensitive,
"=" => "="
);
-- This is the map that associates objects and their names.
Core_Map : Name_Map.Map;
End Daniel.Implementation;
------------------------------------------------
-- Daniel-API.ads
Private With
Daniel.Implementation;
Private Package Daniel.API with Preelaborate is
-- The base API-visable type.
Type API_Base(<>) is new Abstract_Base with private;
-- Creation functions.
Function Create(Name : String) return API_Base;
Function Create(Name : String; Op : Callback) return API_Base;
-- Interface functions.
Function As_String (Object : API_Base) return String;
Procedure Execute (Object : in out API_Base);
Private
-- We derive from implementation's base, and add a discriminant for the
-- callback and another fata-field.
Type API_Base( CBK : Callback; Length : Positive ) is
new Daniel.Implementation.Implementation_Base( Name_Length => Length )
and Abstract_Base with record
A_1 : Character := 'C';
end record;
-- We raise an exception when there is no callback given.
Function Create(Name : String) return API_Base is
(raise Program_Error with "Callback MUST be specified.");
-- Finally, we construct an object from a call to implementation's create
-- and fill-in the missing information using an "extension aggrigate".
Function Create(Name : String; Op : Callback) return API_Base is
(Implementation.Create(Name) with
CBK => Op, Length => Name'Length, others => <>);
End Daniel.API;
------------------------------------------------------------------------------
-- Daniel-Implementation.adb
with
Ada.Exceptions,
Ada.Finalization;
use
Ada.Finalization;
Package Body Daniel.Implementation is
Function "=" (Left, Right : String) return Boolean
renames Ada.Strings.Equal_Case_Insensitive;
Function Get_Name(Object: Implementation_Base'Class) Return String is
(Object.Name);
Function Make(Name : String) return Implementation_Base'Class is
Begin
Return Core_Map(Name);
Exception
when PE : Program_Error =>
raise Constraint_Error with Ada.Exceptions.Exception_Message(PE);
End Make;
Function "="(Left, Right : Implementation_Base) return boolean is
(Left.Name = Right.Name);
Function Create(Name : String) return Implementation_Base is
begin
Return Result : Constant Implementation_Base :=
(Controlled with Name_Length => Name'Length, Name => Name) do
Core_Map.Include(New_Item => Result, Key => Name);
end return;
end Create;
Procedure Finalize(Object : in out Implementation_Base) is
Begin
Core_Map.Delete( Object.Name );
End Finalize;
End Daniel.Implementation;
------------------------------------------------------
-- Daniel-API.adb
Package Body Daniel.API is
Procedure Execute (Object : in out API_Base) is
Begin
Object.CBK.All(Object);
End Execute;
Function As_String (Object : in API_Base) return String is
Begin
Return '(' & Object.Get_Name & ", " & Object.A_1 & ')';
End As_String;
End Daniel.API;
^ permalink raw reply [relevance 4%]
* Re: Newbie question # 2
2020-08-06 18:56 6% ` Simon Wright
@ 2020-08-06 19:41 0% ` Ian Douglas
0 siblings, 0 replies; 26+ results
From: Ian Douglas @ 2020-08-06 19:41 UTC (permalink / raw)
On Thursday, 6 August 2020 20:56:25 UTC+2, Simon Wright wrote:
>
> I'd think of a record type to contain the properties, and then a map
> from object name to properties:
Yes, the variables are actually records.
>
> package Object_Maps is new Ada.Containers.Indefinite_Ordered_Maps
> (Key_Type => String,
> Element_Type => Properties);
>
> Objects : Object_Maps.Map;
Okay that's a new construct I haven't come across yet. Let me see what I can dig up on that.
Thanks, Ian
^ permalink raw reply [relevance 0%]
* Re: Newbie question # 2
@ 2020-08-06 18:56 6% ` Simon Wright
2020-08-06 19:41 0% ` Ian Douglas
0 siblings, 1 reply; 26+ results
From: Simon Wright @ 2020-08-06 18:56 UTC (permalink / raw)
Ian Douglas <ian@vionia.com> writes:
> In PHP, let's say we have a variable $fruit which contains the string
> "banana".
>
> In PHP, if I do $$fruit, then it creates a variable $banana, which I
> can then do things with.
>
> Does Ada support any such concept of taking the contents of one
> variable and using THAT as a variable?
>
> I'm reading in a file which has a name of an object followed by some
> properties so I want to use the name as a variable ... File is
> something I created, so it's not some random stuff, and the variables
> will be existing already.
I'd think of a record type to contain the properties, and then a map
from object name to properties:
type Properties is record
Length : Positive;
Width : Positive;
end record;
package Object_Maps is new Ada.Containers.Indefinite_Ordered_Maps
(Key_Type => String,
Element_Type => Properties);
Objects : Object_Maps.Map;
^ permalink raw reply [relevance 6%]
* Re: Ada.Containers and concurrent modification exception.
2018-09-19 13:12 5% Ada.Containers and concurrent modification exception rakusu_klein
2018-09-19 15:22 0% ` Jacob Sparre Andersen
2018-09-19 15:53 0% ` Simon Wright
@ 2018-09-19 20:16 0% ` Jeffrey R. Carter
2 siblings, 0 replies; 26+ results
From: Jeffrey R. Carter @ 2018-09-19 20:16 UTC (permalink / raw)
On 09/19/2018 03:12 PM, rakusu_klein@fastmail.jp wrote:
>
> with Ada.Containers.Indefinite_Ordered_Maps;
> ...
> The_Map : Map;
> ...
> declare
> I : Cursor := First (The_Map);
> J : Cursor := First (The_Map);
> begin
> -- Now Cursors are synchronized with each other and with a container.
> Delete (The_Map, I);
> -- It's O'k. But now J lost a sync and points to a dead Node.
> Next (J);
> -- What should I expected here,
> -- any well defined exception or
> -- raising a zombie?
> end;
The ARM covers this case in ARM A.18.4(76-80) [I am unable to access the current
ARM right now, so I'm quoting from ISO/IEC 8652:2007, which should be similar]:
"A Cursor value is invalid if ... The node it designates has been deleted from
the map. The result of "=" or Has_Element is unspecified if these functions are
called with an invalid cursor parameter. Execution is erroneous if any other
subprogram declared in Containers.Hashed_Maps or Containers.Ordered_Maps is
called with an invalid cursor parameter.
So J is invalid and Next (J) is erroneous. ARM 1.1.5(10) defines erroneous
execution: "there is no language-specified bound on the possible effect of
erroneous execution; the effect is in general not predictable." In other words,
this call can do anything.
--
Jeff Carter
"I spun around, and there I was, face to face with a
six-year-old kid. Well, I just threw my guns down and
walked away. Little bastard shot me in the ass."
Blazing Saddles
40
^ permalink raw reply [relevance 0%]
* Re: Ada.Containers and concurrent modification exception.
2018-09-19 13:12 5% Ada.Containers and concurrent modification exception rakusu_klein
2018-09-19 15:22 0% ` Jacob Sparre Andersen
@ 2018-09-19 15:53 0% ` Simon Wright
2018-09-19 20:16 0% ` Jeffrey R. Carter
2 siblings, 0 replies; 26+ results
From: Simon Wright @ 2018-09-19 15:53 UTC (permalink / raw)
rakusu_klein@fastmail.jp writes:
> Why Ada's Cursors does not provide the
> ConcurrentModificationException, as Java Collections do, or some
> variant of it? Consider the following:
>
> with Ada.Containers.Indefinite_Ordered_Maps;
> ...
> The_Map : Map;
> ...
> declare
> I : Cursor := First (The_Map);
> J : Cursor := First (The_Map);
> begin
> -- Now Cursors are synchronized with each other and with a container.
> Delete (The_Map, I);
> -- It's O'k. But now J lost a sync and points to a dead Node.
> Next (J);
> -- What should I expected here,
> -- any well defined exception or
> -- raising a zombie?
> end;
What actually happens in this case (GNAT CE 2018) is that the program
enters an endless loop looking at (what it thinks is) a node with both
left and right pointers designating itself.
The ARM goes to a lot of trouble to prevent "tampering with cursors",
but that's mainly to do with detecting altering the structure of a
container while iterating over it, and the code you show isn't really
covered by that. So I'm not sure if it isn't 'just' erroneous[1].
It would be a good thing if the error was detected. Perhaps submit a bug
report to AdaCore?
[1] http://www.adaic.org/resources/add_content/docs/95style/html/sec_5/5-9.html
^ permalink raw reply [relevance 0%]
* Re: Ada.Containers and concurrent modification exception.
2018-09-19 13:12 5% Ada.Containers and concurrent modification exception rakusu_klein
@ 2018-09-19 15:22 0% ` Jacob Sparre Andersen
2018-09-19 15:53 0% ` Simon Wright
2018-09-19 20:16 0% ` Jeffrey R. Carter
2 siblings, 0 replies; 26+ results
From: Jacob Sparre Andersen @ 2018-09-19 15:22 UTC (permalink / raw)
rakusu_klein@fastmail.jp writes:
> Why Ada's Cursors does not provide the
> ConcurrentModificationException, as Java Collections do,
Because that is something from Java. ;-)
> or some variant of it?
The Ada containers define the concept of tampering. I can't remember
which exception you get in case you tamper with a standard container,
but you can be pretty sure you will get one.
> Consider the following:
>
> with Ada.Containers.Indefinite_Ordered_Maps;
> ...
> The_Map : Map;
> ...
> declare
> I : Cursor := First (The_Map);
> J : Cursor := First (The_Map);
> begin
> -- Now Cursors are synchronized with each other and with a container.
> Delete (The_Map, I);
> -- It's O'k. But now J lost a sync and points to a dead Node.
> Next (J);
> -- What should I expected here,
> -- any well defined exception or
> -- raising a zombie?
> end;
Did you try it?
Both with GCC 6.3.0 and with GNAT CE 2018 I get
System.Assertions.Assert_Failure, but that is definitely not defined as
a part of the tampering checks, so I suspect GNAT is wrong (but still
safe) here.
I've posted an executable example here:
https://bitbucket.org/sparre/ada-2012-examples/src/default/src/container_tampering.adb
(Randy, feel free to adapt it for ACATS, if it shows something relevant)
Greetings,
Jacob
--
"In case of discrepancy, you must ignore what they ask for
and give what they need, ignore what they would like and
tell them what they don't want to hear but need to know."
-- E.W. Dijkstra
^ permalink raw reply [relevance 0%]
* Ada.Containers and concurrent modification exception.
@ 2018-09-19 13:12 5% rakusu_klein
2018-09-19 15:22 0% ` Jacob Sparre Andersen
` (2 more replies)
0 siblings, 3 replies; 26+ results
From: rakusu_klein @ 2018-09-19 13:12 UTC (permalink / raw)
Hi all!
Why Ada's Cursors does not provide the ConcurrentModificationException, as Java Collections do, or some variant of it? Consider the following:
with Ada.Containers.Indefinite_Ordered_Maps;
...
The_Map : Map;
...
declare
I : Cursor := First (The_Map);
J : Cursor := First (The_Map);
begin
-- Now Cursors are synchronized with each other and with a container.
Delete (The_Map, I);
-- It's O'k. But now J lost a sync and points to a dead Node.
Next (J);
-- What should I expected here,
-- any well defined exception or
-- raising a zombie?
end;
Regards.
^ permalink raw reply [relevance 5%]
* Re: New to Ada need help implementing Warshall's algorithm
@ 2016-09-26 20:40 6% ` Simon Wright
0 siblings, 0 replies; 26+ results
From: Simon Wright @ 2016-09-26 20:40 UTC (permalink / raw)
Stephen Leake <stephen_leake@stephe-leake.org> writes:
> On Friday, September 23, 2016 at 10:07:53 AM UTC-5, James Brewer wrote:
>>
>> It is three diffent sets of data. I think I may try to simplify the
>> input data to a 0,1 2d array for each set, read the set in and then
>> process each set writing it to an output file (the last two I will
>> have to figure out).
>
> Here's a working program that does the IO, to get you started. It
> reads from a file, writes to standard out.
And here's a different one, which works out the size of the matrix by
finding the number of unique names in the input. The structure supports
strings for names, but the implementation only handles single-character
names because I was being lazy.
Input:
e b
a b
b c
b d
d a
d e
c e
Output:
a 3
b 2
c 4
d 5
e 1
01000
00011
01000
10000
10100
Code:
with Ada.Command_Line;
with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Text_IO; use Ada.Text_IO;
procedure Brewer is
File : File_Type;
package Names_To_Indices
is new Ada.Containers.Indefinite_Ordered_Maps (String, Positive);
Names : Names_To_Indices.Map;
procedure Add_If_New (Name : String)
is
use type Ada.Containers.Count_Type;
begin
if not Names.Contains (Name) then
Names.Insert (Name, Positive (Names.Length + 1));
end if;
end Add_If_New;
begin
Open (File, In_File, Ada.Command_Line.Argument (1));
-- each line is to have format Name_1 Name_2, implying there is a
-- path from Name_1 to Name_2.
loop
begin
declare
Line : constant String := Get_Line (File);
begin
-- I'm being lazy here and assuming single-character Names.
Add_If_New (Line (1 .. 1));
Add_If_New (Line (3 .. 3));
end;
exception
when others => exit;
end;
end loop;
Reset (File);
-- output name-to-index (ordered by name, not index, sorry)
for J in Names.Iterate loop
Put_Line (Names_To_Indices.Key (J)
& " "
& Names_To_Indices.Element (J)'Img);
end loop;
-- now we know the size of the matrix
declare
Size : constant Positive := Positive (Names.Length);
Matrix : array (1 .. Size, 1 .. Size) of Boolean
:= (others => (others => False));
begin
-- populate the matrix
loop
begin
declare
Line : constant String := Get_Line (File);
From : constant Positive := Names.Element (Line (1 .. 1));
To : constant Positive := Names.Element (Line (3 .. 3));
begin
Matrix (From, To) := True;
end;
exception
when others => exit;
end;
end loop;
Close (File);
-- dump the matrix
for J in Matrix'Range (1) loop
for K in Matrix'Range (2) loop
Put (if Matrix (J, K) then '1' else '0');
end loop;
New_Line;
end loop;
end;
end Brewer;
^ permalink raw reply [relevance 6%]
* Re: New to Ada need help implementing Warshall's algorithm
2016-09-23 4:31 6% ` Shark8
@ 2016-09-23 14:54 0% ` James Brewer
1 sibling, 0 replies; 26+ results
From: James Brewer @ 2016-09-23 14:54 UTC (permalink / raw)
On Thursday, September 22, 2016 at 11:31:53 PM UTC-5, Shark8 wrote:
> On Wednesday, September 21, 2016 at 4:05:12 PM UTC-6, James Brewer wrote:
> > Hello I hope this is right forum for this question. I have been asked to write a program that implements Warshall's algorithm using Ada. The problem, I have never written an Ada program and I a limited time frame to put this together.
> > I have have the IDE installed and am in the process of writing some rudimentary programs to familiarize myself with the language but I'm afraid that I may run out of time.
> >
> > The input data I have is a series of connections between 7 to 9 entities that would be stored in a file.
> >
> > examples: A->B A->D C->D
> > alice->bob alice->larry bob -> larry
> > 1 -> 3 1 -> 5 2 -> 5
> >
> > Any help you could offer would be greatly appreciated.
> > Thanks
>
>
> This sounds kind of like homework, is it?
>
> In any case, what you could do is use Ada.Containers to handle the problem:
> * Create an enumeration for nodes, perhaps Node_01 to Node_10.
> * Instantiate Ada.Containers.Indefinite_Vectors with that enumeration as key and element as string. (This is to associate your input-variables w/ the enumeration.)
> * Instantiate Ada.Containers.Ordered_Sets with the enumeration; this is to represent node-connections.
> * Instantiate Ada.Containers.Indefinite_Ordered_Maps with the Set-type from the above as the element and the enumeration as the key.
>
> The rest is left to you.
It is a homework of sorts, but not in the way you'd normally think. The instructor uses Ada when teaching algorithms for the examples but he expects you to teach yourself Ada on your own while trying to learn the algorithms. This is a bit daunting when you don't know what the language can and cannot do.
Thanks for the help, I appreciate it.
^ permalink raw reply [relevance 0%]
* Re: New to Ada need help implementing Warshall's algorithm
@ 2016-09-23 4:31 6% ` Shark8
2016-09-23 14:54 0% ` James Brewer
0 siblings, 2 replies; 26+ results
From: Shark8 @ 2016-09-23 4:31 UTC (permalink / raw)
On Wednesday, September 21, 2016 at 4:05:12 PM UTC-6, James Brewer wrote:
> Hello I hope this is right forum for this question. I have been asked to write a program that implements Warshall's algorithm using Ada. The problem, I have never written an Ada program and I a limited time frame to put this together.
> I have have the IDE installed and am in the process of writing some rudimentary programs to familiarize myself with the language but I'm afraid that I may run out of time.
>
> The input data I have is a series of connections between 7 to 9 entities that would be stored in a file.
>
> examples: A->B A->D C->D
> alice->bob alice->larry bob -> larry
> 1 -> 3 1 -> 5 2 -> 5
>
> Any help you could offer would be greatly appreciated.
> Thanks
This sounds kind of like homework, is it?
In any case, what you could do is use Ada.Containers to handle the problem:
* Create an enumeration for nodes, perhaps Node_01 to Node_10.
* Instantiate Ada.Containers.Indefinite_Vectors with that enumeration as key and element as string. (This is to associate your input-variables w/ the enumeration.)
* Instantiate Ada.Containers.Ordered_Sets with the enumeration; this is to represent node-connections.
* Instantiate Ada.Containers.Indefinite_Ordered_Maps with the Set-type from the above as the element and the enumeration as the key.
The rest is left to you.
^ permalink raw reply [relevance 6%]
* How do I get an enctry in a protected object to block until a certain item arrives from a producer task?
@ 2016-08-23 17:15 4% john
0 siblings, 0 replies; 26+ results
From: john @ 2016-08-23 17:15 UTC (permalink / raw)
Hi! I've also asked this on Stackoverflow because I'm really stuck with this. I have a protected object that contains an ordered hash map. It stored events by their id as they are provided by some producer task. Now one or more consumer tasks can obtain these events, but I need a call that blocks the consumer until a given id has arrived while the producer continues producing. So a simple barrier doesn't work.
I can't find a directly applicable design pattern in my Ada books for this, although I imagine this is some kind of FAQ.
Here is the relevant code snippet:
package Reply_Storage is new Ada.Containers.Indefinite_Ordered_Maps
(Key_Type => Command_Id_Type,
Element_Type => Event_Type);
protected type Reply_Queue is
procedure Put (Event : Event_Type);
entry Take (Id : Command_Id_Type; Event : out Event_Type);
private
Storage : Reply_Storage.Map;
end Reply_Queue;
protected body Reply_Queue is
procedure Put (Event : Event_Type) is
Id : Command_Id_Type := Event_Command_Id (Event);
begin
Storage.Insert (Id, Event);
end Put;
entry Take (Id : Command_Id_Type; Event : out Event_Type)
when not Storage.Is_Empty is
begin
if Storage.Contains(Id) then
Event := Storage.Element (Id);
Storage.Delete (Id);
end if;
end Take;
end Reply_Queue;
Basically, instead of not Storage.Is_Empty, I'd not the condition Storage.Contains(Id). The consumer should block until the map has received the event with the given id. But I don't know how. :/
^ permalink raw reply [relevance 4%]
* Interesting containers problem.
@ 2015-04-17 13:42 7% Shark8
0 siblings, 0 replies; 26+ results
From: Shark8 @ 2015-04-17 13:42 UTC (permalink / raw)
Ok, so let's say we have a type for Identifiers:
SubType Identifier is String
with Dynamic_Predicate => Is_Valid( Identifier )
or else raise Parse_Error with "Invalid identifier: """ & Identifier & '"';
--...
-- ACH is a rename for Ada.Characters.Handling.
Function Is_Valid( Input: String ) return Boolean is
( Input'Length in Positive and then
ACH.Is_Letter(Input(Input'First)) and then
ACH.Is_Alphanumeric(Input(Input'Last)) and then
(for all Ch of Input => Ch = '_' or ACH.Is_Alphanumeric(Ch)) and then
(for all Index in Input'First..Positive'Pred(Input'Last) =>
(if Input(Index) = '_' then Input(Index+1) /= '_')
)
);
And a few types for types:
Type Data_Type is ( Integer, Float, Fixed );
Type Variable_Data( Type_Value : Data_Type ) is
case Type_Value is
when Integer => Integer_Value : Standard.Integer;
when Float => Float_Value : Standard.Float;
when Fixed => Fixed_Value : Fixed_Type; -- Defined elsewhere.
end case;
end record;
Now we can define a Symbol-table using the standard containers simply with this:
Package Symbol_Table is
new Ada.Containers.Indefinite_Ordered_Maps(
Key_Type => Identifier,
Element_Type => Variable_Data,
"<" => Ada.Strings.Less_Case_Insensitive,
"=" => "="
);
And that's all well and good; however, there is one limitation here that is revealed when you need nesting scopes -- there is, apparently, no way to define an Element_Type to feed to Indefinite_Ordered_Maps which is an instance of Indefinite_Ordered_Maps.Maps or an instance of Variable_Data (by way of a variant record; even one which is forward declared).
What would be the proper way to handle this sort of situation?
^ permalink raw reply [relevance 7%]
* Re: A bad counterintuitive behaviour of Ada about OO
@ 2014-08-08 19:34 3% ` Shark8
0 siblings, 0 replies; 26+ results
From: Shark8 @ 2014-08-08 19:34 UTC (permalink / raw)
On 08-Aug-14 05:20, Dmitry A. Kazakov wrote:
> And they [subtypes] break in-operations. As an example consider:
>
> X : Integer := -1;
>
> Now substitute Positive for Integer.
That's going the wrong way.
You're narrowing the set when you move to the subtype, so obviously not
all values will be present; this is a Good Thing.
For example, we can enforce consistency [and correctness] in a DB with
subtypes:
Subtype Digit is Character range '0'..'9';
-- The following is a string, of length 9, that has ONLY digits.
Subtype Social_Security_Number is String(1..9)
with Dynamic_Predicate =>
(for all C of Social_Security_Number => C in Digit);
-- The following function cannot have an invalid invalid SSN parameter.
Procedure Save( SSN : Social_Security_Number; ID: User_ID);
Function Load(ID: User_ID) return Social_Security_Number;
And this is good because we *don't* want any string in the DB's SSN
field, we only want strings which are SSNs.
Likewise, we may want Ada-like identifiers, say in a mapping:
-- Validation rules:
-- #1 - Identifier cannot be the empty-string.
-- #2 - Identifier must contain only alphanumeric characters +
underscore.
-- #3 - Identifier cannot begin with a digit.
-- #4 - Identifier cannot begin or end with an underscore.
-- #5 - Identifier cannot have two consecutive underscores.
Function Valid_Identifier(Input : String) return Boolean;
-- A string containing an identifier.
Subtype Identifier is String
with Dynamic_Predicate => Valid_Identifier( Identifier )
or else raise Constraint_Error;
-- This package defines a mapping of a name to a type; both of these
-- are instances of Identifier.
Package Attribute_List is new Ada.Containers.Indefinite_Ordered_Maps(
Key_Type => Identifier,
Element_Type => Identifier
);
-- ...in body.
Function Valid_Identifier(Input : String) return Boolean is
Subtype Internal_Range is Natural range
Input'First+1..Input'Last-1;
First : Character renames Input(Input'First);
Last : Character renames Input(Input'Last);
Use Ada.Characters.Handling;
Begin
-- Initialize w/ conformance to rule #1.
Return Result : Boolean:= Input'Length in Positive do
-- Rule 2
Result:= Result and
(For all C of Input => Is_Alphanumeric(C) OR C = '_');
-- Rule 3
Result:= Result and not Is_Decimal_Digit(First);
-- Rule 4
Result:= Result and First /= '_' and Last /= '_';
-- Rule 5
Result:= Result and
(for all Index in Internal_Range =>
(if Input(Index) = '_' then Input(Index+1) /= '_')
);
end return;
End Valid_Identifier;
And this is good.
We *don't* want to substitute STRING for Social_Security_Number or
Identifier as the values that STRING can take are outside what we want
to deal with... and if we had to deal with validation at every
subprogram-call or function-return then Ada would be little better than PHP.
> Subsetting means nothing to subtyping and both very little to
substitutability. All three are different things.
Ridiculous; as shown above subtyping *is* the subsetting of the valid
values: Social_Security_Number in particular has only 10**9 values
rather than the Σ(n=0..Positive'Last) 256**n values that the STRING type
would have.
>
> Huh, great mathematical problems are about fighting constraints. E.g.
> solving x**n + y**n = z**n in real numbers vs. in natural ones. No big
> deal? Same applies to programming, it is mostly about working around
> constraints.
...that's the most idiotic thing I've *ever* heard you say.
Constraints are fundamental for mathematical proofs; they are essential
for making robust programs. (HINT: definitions are often constraints.)
^ permalink raw reply [relevance 3%]
* Re: How to use associative arrays in Ada 2005?
@ 2006-11-21 14:18 5% ` Matthew Heaney
0 siblings, 0 replies; 26+ results
From: Matthew Heaney @ 2006-11-21 14:18 UTC (permalink / raw)
"snoopysalive" <matthias.kistler@gmx.de> writes:
> Can anybody explain me how to use associative arrays in Ada 2005? I
> mean hashes like in Perl.
There are actually two kinds of "associative arrays" in Ada05: ordered maps and
hashed maps. Each of these container types accept both a key and element as
generic formal types. (There are also sets, that accept just an element type.)
If both the key and element are "definite" types (types that don't require a
constraint to specify the size), then you can use:
ada.containers.hashed_maps
ada.containers.ordered_maps
If either the key or element is an "indefinite" type (such as String), then you
can use:
ada.containers.indefinite_hashed_maps
ada.containers.indefinite_ordered_maps
If you use the hashed version, you'll need a hash function for your key type.
The library comes with a hash function for type String (and Wide_String, etc);
see Ada.Strings.Hash.
If you use the ordered version, you'll need a relation operation ("<") for your
key type.
> In my opinion, C++ is cool but Ada's syntax is
> better to avoid dirty code.
If you're familiar with the STL, then you should have no trouble with the Ada
container library.
> So, when I say "hash", I mean something Perl-like like
> "$hashname{key1}{key2} = 'something' ". Or something C++-like like "map
> <string,int> hashname; hashname["key1"] = 42;".
Right. People often say "hash" but in reality that's just one way of
implementing an associative container. In Ada05 you can use either the hashed
version or the ordered version.
Your example above would be:
package String_Integer_Maps is
new Ada.Containers.Indefinite_Hashed_Maps
(String,
Integer,
Ada.Strings.Hash,
Equivalent_Keys => "=");
Note that there's no index operator (operator[]()) in Ada, so you say:
procedure Op (M : in out String_Integer_Maps.Map) is
begin
M.Include ("key1", 42);
end;
Note that this is not exactly equivalent to the C++ operation, since in Ada the
key is replaced too (if it already exists). That's unnecessary here so a
slightly more efficient technique might be:
procedure Op (M : in out String_Integer_Maps.Map) is
C : Cursor;
B : Boolean;
begin
M.Insert ("key1", 42, C, B);
if not B then
M.Replace_Element (C, 42);
end if;
end Op;
> Is there anything similar in Ada 2005, too? I bought the book
> "Programming in Ada 2005" by John Barnes but I don't understand the
> author's way of explaining a programming language (for me, the book is
> more confusing than explaining).
That book has a chapter (17?) on the container library. If you have a specific
question just post here or send me some email.
> Or does anybody know a good tutorial similar to the lots of C- and
> Perl-tutorials? I found many Ada-tutorials but most of them just list
> the contents of the built-in packages and don't explain how to use
> them. As a beginner this is confusing.
If just gave a tutorial on the Ada05 container library. I can give you the
power-point slides or send you a pdf version. Drop me a line if you're
interested.
But as a said above, the Ada standard container library is very similar to the
C++ STL, so if you already know the latter than the former shouldn't be much of
a stretch.
-Matt
^ permalink raw reply [relevance 5%]
* Re: Hash table
@ 2005-08-13 23:58 5% ` Matthew Heaney
0 siblings, 0 replies; 26+ results
From: Matthew Heaney @ 2005-08-13 23:58 UTC (permalink / raw)
David Trudgett <wpower@zeta.org.au.nospamplease> writes:
> I'm looking for a Free Software Ada95 container library, or in
> particular, a hash table (or associative list).
Ada 2005 will have both sets and maps. You're asking specifically for a
hashed version, but keep in mind that an ordered container (having an
identical interface, but different time complexity) might satisfy your
needs just as well.
The hashed containers are:
ada.containers.hashed_sets
ada.containers.indefinite_hashed_sets
ada.containers.hashed_maps
ada.containers.indefinite_hashed_maps
The ordered forms are:
ada.containers.ordered_sets
ada.containers.indefinite_ordered_sets
ada.containers.ordered_maps
ada.containers.indefinite_ordered_maps
> I noticed that Ada 2005 may include a standard Ada.Containers library,
> but is there a working prototype of this available now?
Yes, there's a public reference implementation available here:
http://charles.tigris.org/
Follow the links to the CVS repository, to the ai302 subdirectory. The
names use gnat run-time syntax, so you're looking for:
a-cohama.ad[sb]
a-cihama.ad[sb]
a-cohase.ad[sb]
a-cihase.ad[sb]
Note that these will only compile with an Ada 2005 compiler. If you're
using the latest version of gnat, use the -gnat05 switch to compile them.
If you don't have an Ada 2005 compiler, then you can modify the sources
to your liking. That will mean replacing an anonymous access subprogram
parameters with something else, typically a generic operation that
passes the subprogram as a generic formal. For example, the procedure:
procedure Iterate
(Container : in Map;
Process : not null access procedure (Position : Cursor));
should be re-written as:
generic
with procedure Process (Position : Cursor);
procedure Generic_Iteration (Container : in Map);
(Note that replacing the anonymous access subprogram parameters with
named access parameters is probably not what you want, because of the
accessibility rules. Hence the generic declaration above.)
> A bit of searching found the ASL (Ada Structured Library --
> http://sourceforge.net/projects/adasl), which hasn't had a new release
> since 2001 (which means it must be perfect ;-)). Should I use ASL, and
> if I do, will it be completely different from the proposed
> Ada.Containers standard?
I would try to use a reference implementation of the standard library,
modified as necessary to run under pure Ada 95. I can help you make the
necessary modifications.
In general, we prefer that users use the standard library now, since
that helps us find bugs in the design of the library (early adopters
have been extremely helpful here), and in the actual implementation of
the library.
> I'm using Gnat (3.15p) on Debian Linux.
Do you have access to gcc 4.x? The standard container library is
already bundled with the gcc 4 release.
-Matt
^ permalink raw reply [relevance 5%]
* Re: Ada.Containers.Indefinite_Ordered_Maps of gcc 4.0.1 has bug ?
2005-08-06 16:33 6% ` Matthew Heaney
@ 2005-08-06 16:49 6% ` Y.Tomino
0 siblings, 0 replies; 26+ results
From: Y.Tomino @ 2005-08-06 16:49 UTC (permalink / raw)
Matthew Heaney wrote:
> "Y.Tomino" <demoonlit@panathenaia.halfmoon.jp> writes:
>
>
>>Now, I downloaded the latest 4.1.0 snapshot from
>>http://mirrors.rcn.net/pub/sourceware/gcc/snapshots/4.1-20050730/
>>however, a-ciorse.abs's Copy_Node is...
>>
>>It seems difference to your suggested code. There is no "Key".
>
>
> Yes, because it's a set, not a key. What about a-ciorma.adb?
Sorry. I mistook the file to see...
a-ciorma.adb's Copy_Node is corrected.
function Copy_Node (Source : Node_Access) return Node_Access is
K : Key_Access := new Key_Type'(Source.Key.all);
E : Element_Access;
begin
E := new Element_Type'(Source.Element.all);
return new Node_Type'(Parent => null,
Left => null,
Right => null,
Color => Source.Color,
Key => K,
Element => E);
exception
when others =>
Free_Key (K);
Free_Element (E);
raise;
end Copy_Node;
I'm expecting the following release of gcc 4.1.0...
YT
^ permalink raw reply [relevance 6%]
* Re: Ada.Containers.Indefinite_Ordered_Maps of gcc 4.0.1 has bug ?
2005-08-06 16:17 5% ` Y.Tomino
@ 2005-08-06 16:33 6% ` Matthew Heaney
2005-08-06 16:49 6% ` Y.Tomino
0 siblings, 1 reply; 26+ results
From: Matthew Heaney @ 2005-08-06 16:33 UTC (permalink / raw)
"Y.Tomino" <demoonlit@panathenaia.halfmoon.jp> writes:
> Now, I downloaded the latest 4.1.0 snapshot from
> http://mirrors.rcn.net/pub/sourceware/gcc/snapshots/4.1-20050730/
> however, a-ciorse.abs's Copy_Node is...
>
> It seems difference to your suggested code. There is no "Key".
Yes, because it's a set, not a key. What about a-ciorma.adb?
^ permalink raw reply [relevance 6%]
* Re: Ada.Containers.Indefinite_Ordered_Maps of gcc 4.0.1 has bug ?
2005-08-06 15:37 5% ` Matthew Heaney
@ 2005-08-06 16:17 5% ` Y.Tomino
2005-08-06 16:33 6% ` Matthew Heaney
0 siblings, 1 reply; 26+ results
From: Y.Tomino @ 2005-08-06 16:17 UTC (permalink / raw)
Thanks!
But I think it's not reflected to FSF...
Matthew Heaney wrote:
>...
> This is an old bug, that was fixed a few months ago. I'm surprised
> you're seeing it. You can simply patch your copy like this:
I downloaded source of gcc 4.0.1 from one of mirrors:
http://mirrors.rcn.net/pub/sourceware/gcc/
>...
>I would submit a bug report either to the FSF or to AdaCore, to ensure
>the fix wends its way to public GCC repositories. This bug was found
>and fixed in AdaCore's sources a while ago, so I don't understand why
>you don't have the latest, corrected version.
Now, I downloaded the latest 4.1.0 snapshot from
http://mirrors.rcn.net/pub/sourceware/gcc/snapshots/4.1-20050730/
however, a-ciorse.abs's Copy_Node is
function Copy_Node (Source : Node_Access) return Node_Access is
Element : Element_Access := new Element_Type'(Source.Element.all);
begin
return new Node_Type'(Parent => null,
Left => null,
Right => null,
Color => Source.Color,
Element => Element);
exception
when others =>
Free_Element (Element);
raise;
end Copy_Node;
It seems difference to your suggested code. There is not "Key".
> function Copy_Node (Source : Node_Access) return Node_Access is
> K : Key_Access := new Key_Type'(Source.Key.all);
> E : Element_Access;
> begin
> E := new Element_Type'(Source.Element.all);
>
> return new Node_Type'(Parent => null,
> Left => null,
> Right => null,
> Color => Source.Color,
> Key => K,
> Element => E);
> exception
> when others =>
> Free_Key (K);
> Free_Element (E);
> raise;
> end Copy_Node;
YT
^ permalink raw reply [relevance 5%]
* Re: Ada.Containers.Indefinite_Ordered_Maps of gcc 4.0.1 has bug ?
[not found] ` <42F4B753.2080004@panathenaia.halfmoon.jp>
@ 2005-08-06 15:37 5% ` Matthew Heaney
2005-08-06 16:17 5% ` Y.Tomino
0 siblings, 1 reply; 26+ results
From: Matthew Heaney @ 2005-08-06 15:37 UTC (permalink / raw)
"Y.Tomino" <demoonlit@panathenaia.halfmoon.jp> writes:
> I send a-ciorma.ad? as attachments.
> (C:\mingw\lib\gcc\i686-pc-mingw32\4.0.1\adainclude\a-ciorma.ads,
> C:\mingw\lib\gcc\i686-pc-mingw32\4.0.1\adainclude\a-ciorma.adb)
>
> I built gcc 4.0.1 with "--enable-languages=c,ada,c++ --prefix=/mingw".
You appear to have an older version of the sources. Here's the problem:
function Copy_Node (Source : Node_Access) return Node_Access is
Target : constant Node_Access :=
new Node_Type'(Parent => null,
Left => null,
Right => null,
Color => Source.Color,
Key => Source.Key,
Element => Source.Element);
begin
return Target;
end Copy_Node;
In this implementation of the indefinite container, keys and elements
are allocated. The code fragment above simply copies the pointers, but
this is wrong, since Adjust must make its own copy.
This is an old bug, that was fixed a few months ago. I'm surprised
you're seeing it. You can simply patch your copy like this:
function Copy_Node (Source : Node_Access) return Node_Access is
K : Key_Access := new Key_Type'(Source.Key.all);
E : Element_Access;
begin
E := new Element_Type'(Source.Element.all);
return new Node_Type'(Parent => null,
Left => null,
Right => null,
Color => Source.Color,
Key => K,
Element => E);
exception
when others =>
Free_Key (K);
Free_Element (E);
raise;
end Copy_Node;
Alternatively you can grab a copy of that module from the repository at
<http://charles.tigris.org/> .
I would submit a bug report either to the FSF or to AdaCore, to ensure
the fix wends its way to public GCC repositories. This bug was found
and fixed in AdaCore's sources a while ago, so I don't understand why
you don't have the latest, corrected version.
-Matt
^ permalink raw reply [relevance 5%]
* Re: Ada.Containers.Indefinite_Ordered_Maps of gcc 4.0.1 has bug ?
2005-08-06 12:54 6% ` Matthew Heaney
@ 2005-08-06 13:13 6% ` Y.Tomino
[not found] ` <42F4B753.2080004@panathenaia.halfmoon.jp>
1 sibling, 0 replies; 26+ results
From: Y.Tomino @ 2005-08-06 13:13 UTC (permalink / raw)
To: Matthew Heaney
[-- Attachment #1: Type: text/plain, Size: 745 bytes --]
I send a-ciorma.ad? as attachments.
(C:\mingw\lib\gcc\i686-pc-mingw32\4.0.1\adainclude\a-ciorma.ads,
C:\mingw\lib\gcc\i686-pc-mingw32\4.0.1\adainclude\a-ciorma.adb)
I built gcc 4.0.1 with "--enable-languages=c,ada,c++ --prefix=/mingw".
Thanks.
YT
Matthew Heaney wrote:
> "Y.Tomino" <demoonlit@panathenaia.halfmoon.jp> writes:
>
>
>>Ada.Containers.Indefinite_Ordered_Maps.Adjust seems to me having bug.
>>Although good if it's my misunderstanding.
>
>
> I just ran your examples, and didn't get any exceptions.
>
> It might be the case that you're using an older version of the sources.
> Can you go into your adainclude directory, and send me your copies of
> a-ciorma.ad?. (That, or send me the context around line 407.)
>
> -Matt
[-- Attachment #2: a-ciorma.ads --]
[-- Type: text/plain, Size: 7655 bytes --]
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.CONTAINERS.INDEFINITE_ORDERED_MAPS --
-- --
-- S p e c --
-- --
-- Copyright (C) 2004 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Containers.Red_Black_Trees;
with Ada.Finalization;
with Ada.Streams;
generic
type Key_Type (<>) is private;
type Element_Type (<>) is private;
with function "<" (Left, Right : Key_Type) return Boolean is <>;
with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Indefinite_Ordered_Maps is
pragma Preelaborate (Indefinite_Ordered_Maps);
type Map is tagged private;
type Cursor is private;
Empty_Map : constant Map;
No_Element : constant Cursor;
function "=" (Left, Right : Map) return Boolean;
function Length (Container : Map) return Count_Type;
function Is_Empty (Container : Map) return Boolean;
procedure Clear (Container : in out Map);
function Key (Position : Cursor) return Key_Type;
function Element (Position : Cursor) return Element_Type;
procedure Query_Element
(Position : Cursor;
Process : not null access procedure (Key : Key_Type;
Element : Element_Type));
procedure Update_Element
(Position : Cursor;
Process : not null access procedure (Key : Key_Type;
Element : in out Element_Type));
procedure Replace_Element (Position : Cursor; By : Element_Type);
procedure Move (Target : in out Map; Source : in out Map);
procedure Insert
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type;
Position : out Cursor;
Inserted : out Boolean);
procedure Insert
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type);
procedure Include
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type);
procedure Replace
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type);
procedure Delete
(Container : in out Map;
Key : Key_Type);
procedure Exclude
(Container : in out Map;
Key : Key_Type);
procedure Delete
(Container : in out Map;
Position : in out Cursor);
procedure Delete_First (Container : in out Map);
procedure Delete_Last (Container : in out Map);
function Contains
(Container : Map;
Key : Key_Type) return Boolean;
function Find
(Container : Map;
Key : Key_Type) return Cursor;
function Element
(Container : Map;
Key : Key_Type) return Element_Type;
function Floor
(Container : Map;
Key : Key_Type) return Cursor;
function Ceiling
(Container : Map;
Key : Key_Type) return Cursor;
function First (Container : Map) return Cursor;
function First_Key (Container : Map) return Key_Type;
function First_Element (Container : Map) return Element_Type;
function Last (Container : Map) return Cursor;
function Last_Key (Container : Map) return Key_Type;
function Last_Element (Container : Map) return Element_Type;
function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor);
procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean;
function "<" (Left, Right : Cursor) return Boolean;
function ">" (Left, Right : Cursor) return Boolean;
function "<" (Left : Cursor; Right : Key_Type) return Boolean;
function ">" (Left : Cursor; Right : Key_Type) return Boolean;
function "<" (Left : Key_Type; Right : Cursor) return Boolean;
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
procedure Reverse_Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor));
private
type Node_Type;
type Node_Access is access Node_Type;
package Tree_Types is
new Red_Black_Trees.Generic_Tree_Types (Node_Access);
use Tree_Types;
use Ada.Finalization;
type Map is new Controlled with record
Tree : Tree_Type := (Length => 0, others => null);
end record;
procedure Adjust (Container : in out Map);
procedure Finalize (Container : in out Map) renames Clear;
type Map_Access is access constant Map;
for Map_Access'Storage_Size use 0;
type Cursor is record
Container : Map_Access;
Node : Node_Access;
end record;
No_Element : constant Cursor := Cursor'(null, null);
use Ada.Streams;
procedure Write
(Stream : access Root_Stream_Type'Class;
Container : Map);
for Map'Write use Write;
procedure Read
(Stream : access Root_Stream_Type'Class;
Container : out Map);
for Map'Read use Read;
Empty_Map : constant Map :=
(Controlled with Tree => (Length => 0, others => null));
end Ada.Containers.Indefinite_Ordered_Maps;
[-- Attachment #3: a-ciorma.adb --]
[-- Type: text/plain, Size: 25588 bytes --]
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
-- ADA.CONTAINERS.INDEFINITE_ORDERED_MAPS --
-- --
-- B o d y --
-- --
-- Copyright (C) 2004 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Ada.Containers.Red_Black_Trees.Generic_Operations;
pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Operations);
with Ada.Containers.Red_Black_Trees.Generic_Keys;
pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys);
with System; use type System.Address;
package body Ada.Containers.Indefinite_Ordered_Maps is
use Red_Black_Trees;
type Key_Access is access Key_Type;
type Element_Access is access Element_Type;
type Node_Type is limited record
Parent : Node_Access;
Left : Node_Access;
Right : Node_Access;
Color : Red_Black_Trees.Color_Type := Red;
Key : Key_Access;
Element : Element_Access;
end record;
-----------------------------
-- Node Access Subprograms --
-----------------------------
-- These subprograms provide a functional interface to access fields
-- of a node, and a procedural interface for modifying these values.
function Color (Node : Node_Access) return Color_Type;
pragma Inline (Color);
function Left (Node : Node_Access) return Node_Access;
pragma Inline (Left);
function Parent (Node : Node_Access) return Node_Access;
pragma Inline (Parent);
function Right (Node : Node_Access) return Node_Access;
pragma Inline (Right);
procedure Set_Parent (Node : Node_Access; Parent : Node_Access);
pragma Inline (Set_Parent);
procedure Set_Left (Node : Node_Access; Left : Node_Access);
pragma Inline (Set_Left);
procedure Set_Right (Node : Node_Access; Right : Node_Access);
pragma Inline (Set_Right);
procedure Set_Color (Node : Node_Access; Color : Color_Type);
pragma Inline (Set_Color);
-----------------------
-- Local Subprograms --
-----------------------
function Copy_Node (Source : Node_Access) return Node_Access;
pragma Inline (Copy_Node);
function Copy_Tree (Source_Root : Node_Access) return Node_Access;
procedure Delete_Tree (X : in out Node_Access);
procedure Free (X : in out Node_Access);
function Is_Equal_Node_Node
(L, R : Node_Access) return Boolean;
pragma Inline (Is_Equal_Node_Node);
function Is_Greater_Key_Node
(Left : Key_Type;
Right : Node_Access) return Boolean;
pragma Inline (Is_Greater_Key_Node);
function Is_Less_Key_Node
(Left : Key_Type;
Right : Node_Access) return Boolean;
pragma Inline (Is_Less_Key_Node);
--------------------------
-- Local Instantiations --
--------------------------
package Tree_Operations is
new Red_Black_Trees.Generic_Operations
(Tree_Types => Tree_Types,
Null_Node => Node_Access'(null));
use Tree_Operations;
package Key_Ops is
new Red_Black_Trees.Generic_Keys
(Tree_Operations => Tree_Operations,
Key_Type => Key_Type,
Is_Less_Key_Node => Is_Less_Key_Node,
Is_Greater_Key_Node => Is_Greater_Key_Node);
procedure Free_Key is
new Ada.Unchecked_Deallocation (Key_Type, Key_Access);
procedure Free_Element is
new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
function Is_Equal is
new Tree_Operations.Generic_Equal (Is_Equal_Node_Node);
---------
-- "<" --
---------
function "<" (Left, Right : Cursor) return Boolean is
begin
return Left.Node.Key.all < Right.Node.Key.all;
end "<";
function "<" (Left : Cursor; Right : Key_Type) return Boolean is
begin
return Left.Node.Key.all < Right;
end "<";
function "<" (Left : Key_Type; Right : Cursor) return Boolean is
begin
return Left < Right.Node.Key.all;
end "<";
---------
-- "=" --
---------
function "=" (Left, Right : Map) return Boolean is
begin
if Left'Address = Right'Address then
return True;
end if;
return Is_Equal (Left.Tree, Right.Tree);
end "=";
---------
-- ">" --
---------
function ">" (Left, Right : Cursor) return Boolean is
begin
return Right.Node.Key.all < Left.Node.Key.all;
end ">";
function ">" (Left : Cursor; Right : Key_Type) return Boolean is
begin
return Right < Left.Node.Key.all;
end ">";
function ">" (Left : Key_Type; Right : Cursor) return Boolean is
begin
return Right.Node.Key.all < Left;
end ">";
------------
-- Adjust --
------------
procedure Adjust (Container : in out Map) is
Tree : Tree_Type renames Container.Tree;
N : constant Count_Type := Tree.Length;
X : constant Node_Access := Tree.Root;
begin
if N = 0 then
pragma Assert (X = null);
return;
end if;
Tree := (Length => 0, others => null);
Tree.Root := Copy_Tree (X);
Tree.First := Min (Tree.Root);
Tree.Last := Max (Tree.Root);
Tree.Length := N;
end Adjust;
-------------
-- Ceiling --
-------------
function Ceiling (Container : Map; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Ops.Ceiling (Container.Tree, Key);
begin
if Node = null then
return No_Element;
else
return Cursor'(Container'Unchecked_Access, Node);
end if;
end Ceiling;
-----------
-- Clear --
-----------
procedure Clear (Container : in out Map) is
Tree : Tree_Type renames Container.Tree;
Root : Node_Access := Tree.Root;
begin
Tree := (Length => 0, others => null);
Delete_Tree (Root);
end Clear;
-----------
-- Color --
-----------
function Color (Node : Node_Access) return Color_Type is
begin
return Node.Color;
end Color;
--------------
-- Contains --
--------------
function Contains (Container : Map; Key : Key_Type) return Boolean is
begin
return Find (Container, Key) /= No_Element;
end Contains;
---------------
-- Copy_Node --
---------------
function Copy_Node (Source : Node_Access) return Node_Access is
Target : constant Node_Access :=
new Node_Type'(Parent => null,
Left => null,
Right => null,
Color => Source.Color,
Key => Source.Key,
Element => Source.Element);
begin
return Target;
end Copy_Node;
---------------
-- Copy_Tree --
---------------
function Copy_Tree (Source_Root : Node_Access) return Node_Access is
Target_Root : Node_Access := Copy_Node (Source_Root);
P, X : Node_Access;
begin
if Source_Root.Right /= null then
Target_Root.Right := Copy_Tree (Source_Root.Right);
Target_Root.Right.Parent := Target_Root;
end if;
P := Target_Root;
X := Source_Root.Left;
while X /= null loop
declare
Y : Node_Access := Copy_Node (X);
begin
P.Left := Y;
Y.Parent := P;
if X.Right /= null then
Y.Right := Copy_Tree (X.Right);
Y.Right.Parent := Y;
end if;
P := Y;
X := X.Left;
end;
end loop;
return Target_Root;
exception
when others =>
Delete_Tree (Target_Root);
raise;
end Copy_Tree;
------------
-- Delete --
------------
procedure Delete
(Container : in out Map;
Position : in out Cursor)
is
begin
if Position = No_Element then
return;
end if;
if Position.Container /= Map_Access'(Container'Unchecked_Access) then
raise Program_Error;
end if;
Delete_Node_Sans_Free (Container.Tree, Position.Node);
Free (Position.Node);
Position.Container := null;
end Delete;
procedure Delete (Container : in out Map; Key : Key_Type) is
X : Node_Access := Key_Ops.Find (Container.Tree, Key);
begin
if X = null then
raise Constraint_Error;
else
Delete_Node_Sans_Free (Container.Tree, X);
Free (X);
end if;
end Delete;
------------------
-- Delete_First --
------------------
procedure Delete_First (Container : in out Map) is
Position : Cursor := First (Container);
begin
Delete (Container, Position);
end Delete_First;
-----------------
-- Delete_Last --
-----------------
procedure Delete_Last (Container : in out Map) is
Position : Cursor := Last (Container);
begin
Delete (Container, Position);
end Delete_Last;
-----------------
-- Delete_Tree --
-----------------
procedure Delete_Tree (X : in out Node_Access) is
Y : Node_Access;
begin
while X /= null loop
Y := X.Right;
Delete_Tree (Y);
Y := X.Left;
Free (X);
X := Y;
end loop;
end Delete_Tree;
-------------
-- Element --
-------------
function Element (Position : Cursor) return Element_Type is
begin
return Position.Node.Element.all;
end Element;
function Element (Container : Map; Key : Key_Type) return Element_Type is
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
begin
return Node.Element.all;
end Element;
-------------
-- Exclude --
-------------
procedure Exclude (Container : in out Map; Key : Key_Type) is
X : Node_Access := Key_Ops.Find (Container.Tree, Key);
begin
if X /= null then
Delete_Node_Sans_Free (Container.Tree, X);
Free (X);
end if;
end Exclude;
----------
-- Find --
----------
function Find (Container : Map; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
begin
if Node = null then
return No_Element;
else
return Cursor'(Container'Unchecked_Access, Node);
end if;
end Find;
-----------
-- First --
-----------
function First (Container : Map) return Cursor is
begin
if Container.Tree.First = null then
return No_Element;
else
return Cursor'(Container'Unchecked_Access, Container.Tree.First);
end if;
end First;
-------------------
-- First_Element --
-------------------
function First_Element (Container : Map) return Element_Type is
begin
return Container.Tree.First.Element.all;
end First_Element;
---------------
-- First_Key --
---------------
function First_Key (Container : Map) return Key_Type is
begin
return Container.Tree.First.Key.all;
end First_Key;
-----------
-- Floor --
-----------
function Floor (Container : Map; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
begin
if Node = null then
return No_Element;
else
return Cursor'(Container'Unchecked_Access, Node);
end if;
end Floor;
----------
-- Free --
----------
procedure Free (X : in out Node_Access) is
procedure Deallocate is
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
begin
if X /= null then
Free_Key (X.Key);
Free_Element (X.Element);
Deallocate (X);
end if;
end Free;
-----------------
-- Has_Element --
-----------------
function Has_Element (Position : Cursor) return Boolean is
begin
return Position /= No_Element;
end Has_Element;
-------------
-- Include --
-------------
procedure Include
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type)
is
Position : Cursor;
Inserted : Boolean;
K : Key_Access;
E : Element_Access;
begin
Insert (Container, Key, New_Item, Position, Inserted);
if not Inserted then
K := Position.Node.Key;
E := Position.Node.Element;
Position.Node.Key := new Key_Type'(Key);
Position.Node.Element := new Element_Type'(New_Item);
Free_Key (K);
Free_Element (E);
end if;
end Include;
------------
-- Insert --
------------
procedure Insert
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type;
Position : out Cursor;
Inserted : out Boolean)
is
function New_Node return Node_Access;
pragma Inline (New_Node);
procedure Insert_Post is
new Key_Ops.Generic_Insert_Post (New_Node);
procedure Insert_Sans_Hint is
new Key_Ops.Generic_Conditional_Insert (Insert_Post);
--------------
-- New_Node --
--------------
function New_Node return Node_Access is
Node : Node_Access := new Node_Type;
begin
Node.Key := new Key_Type'(Key);
Node.Element := new Element_Type'(New_Item);
return Node;
exception
when others =>
-- On exception, deallocate key and elem
Free (Node);
raise;
end New_Node;
-- Start of processing for Insert
begin
Insert_Sans_Hint
(Container.Tree,
Key,
Position.Node,
Inserted);
Position.Container := Container'Unchecked_Access;
end Insert;
procedure Insert
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type)
is
Position : Cursor;
Inserted : Boolean;
begin
Insert (Container, Key, New_Item, Position, Inserted);
if not Inserted then
raise Constraint_Error;
end if;
end Insert;
--------------
-- Is_Empty --
--------------
function Is_Empty (Container : Map) return Boolean is
begin
return Container.Tree.Length = 0;
end Is_Empty;
------------------------
-- Is_Equal_Node_Node --
------------------------
function Is_Equal_Node_Node
(L, R : Node_Access) return Boolean is
begin
return L.Element.all = R.Element.all;
end Is_Equal_Node_Node;
-------------------------
-- Is_Greater_Key_Node --
-------------------------
function Is_Greater_Key_Node
(Left : Key_Type;
Right : Node_Access) return Boolean
is
begin
-- k > node same as node < k
return Right.Key.all < Left;
end Is_Greater_Key_Node;
----------------------
-- Is_Less_Key_Node --
----------------------
function Is_Less_Key_Node
(Left : Key_Type;
Right : Node_Access) return Boolean is
begin
return Left < Right.Key.all;
end Is_Less_Key_Node;
-------------
-- Iterate --
-------------
procedure Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor))
is
procedure Process_Node (Node : Node_Access);
pragma Inline (Process_Node);
procedure Local_Iterate is
new Tree_Operations.Generic_Iteration (Process_Node);
------------------
-- Process_Node --
------------------
procedure Process_Node (Node : Node_Access) is
begin
Process (Cursor'(Container'Unchecked_Access, Node));
end Process_Node;
-- Start of processing for Iterate
begin
Local_Iterate (Container.Tree);
end Iterate;
---------
-- Key --
---------
function Key (Position : Cursor) return Key_Type is
begin
return Position.Node.Key.all;
end Key;
----------
-- Last --
----------
function Last (Container : Map) return Cursor is
begin
if Container.Tree.Last = null then
return No_Element;
else
return Cursor'(Container'Unchecked_Access, Container.Tree.Last);
end if;
end Last;
------------------
-- Last_Element --
------------------
function Last_Element (Container : Map) return Element_Type is
begin
return Container.Tree.Last.Element.all;
end Last_Element;
--------------
-- Last_Key --
--------------
function Last_Key (Container : Map) return Key_Type is
begin
return Container.Tree.Last.Key.all;
end Last_Key;
----------
-- Left --
----------
function Left (Node : Node_Access) return Node_Access is
begin
return Node.Left;
end Left;
------------
-- Length --
------------
function Length (Container : Map) return Count_Type is
begin
return Container.Tree.Length;
end Length;
----------
-- Move --
----------
procedure Move (Target : in out Map; Source : in out Map) is
begin
if Target'Address = Source'Address then
return;
end if;
Move (Target => Target.Tree, Source => Source.Tree);
end Move;
----------
-- Next --
----------
function Next (Position : Cursor) return Cursor is
begin
if Position = No_Element then
return No_Element;
end if;
declare
Node : constant Node_Access := Tree_Operations.Next (Position.Node);
begin
if Node = null then
return No_Element;
else
return Cursor'(Position.Container, Node);
end if;
end;
end Next;
procedure Next (Position : in out Cursor) is
begin
Position := Next (Position);
end Next;
------------
-- Parent --
------------
function Parent (Node : Node_Access) return Node_Access is
begin
return Node.Parent;
end Parent;
--------------
-- Previous --
--------------
function Previous (Position : Cursor) return Cursor is
begin
if Position = No_Element then
return No_Element;
end if;
declare
Node : constant Node_Access :=
Tree_Operations.Previous (Position.Node);
begin
if Node = null then
return No_Element;
end if;
return Cursor'(Position.Container, Node);
end;
end Previous;
procedure Previous (Position : in out Cursor) is
begin
Position := Previous (Position);
end Previous;
-------------------
-- Query_Element --
-------------------
procedure Query_Element
(Position : Cursor;
Process : not null access procedure (Element : Element_Type))
is
begin
Process (Position.Node.Key.all, Position.Node.Element.all);
end Query_Element;
----------
-- Read --
----------
procedure Read
(Stream : access Root_Stream_Type'Class;
Container : out Map)
is
N : Count_Type'Base;
function New_Node return Node_Access;
pragma Inline (New_Node);
procedure Local_Read is new Tree_Operations.Generic_Read (New_Node);
--------------
-- New_Node --
--------------
function New_Node return Node_Access is
Node : Node_Access := new Node_Type;
begin
Node.Key := new Key_Type'(Key_Type'Input (Stream));
Node.Element := new Element_Type'(Element_Type'Input (Stream));
return Node;
exception
when others =>
-- Deallocate key and elem too on exception
Free (Node);
raise;
end New_Node;
-- Start of processing for Read
begin
Clear (Container);
Count_Type'Base'Read (Stream, N);
pragma Assert (N >= 0);
Local_Read (Container.Tree, N);
end Read;
-------------
-- Replace --
-------------
procedure Replace
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type)
is
Node : constant Node_Access :=
Key_Ops.Find (Container.Tree, Key);
K : Key_Access;
E : Element_Access;
begin
if Node = null then
raise Constraint_Error;
end if;
K := Node.Key;
E := Node.Element;
Node.Key := new Key_Type'(Key);
Node.Element := new Element_Type'(New_Item);
Free_Key (K);
Free_Element (E);
end Replace;
---------------------
-- Replace_Element --
---------------------
procedure Replace_Element (Position : Cursor; By : Element_Type) is
X : Element_Access := Position.Node.Element;
begin
Position.Node.Element := new Element_Type'(By);
Free_Element (X);
end Replace_Element;
---------------------
-- Reverse_Iterate --
---------------------
procedure Reverse_Iterate
(Container : Map;
Process : not null access procedure (Position : Cursor))
is
procedure Process_Node (Node : Node_Access);
pragma Inline (Process_Node);
procedure Local_Reverse_Iterate is
new Tree_Operations.Generic_Reverse_Iteration (Process_Node);
------------------
-- Process_Node --
------------------
procedure Process_Node (Node : Node_Access) is
begin
Process (Cursor'(Container'Unchecked_Access, Node));
end Process_Node;
-- Start of processing for Reverse_Iterate
begin
Local_Reverse_Iterate (Container.Tree);
end Reverse_Iterate;
-----------
-- Right --
-----------
function Right (Node : Node_Access) return Node_Access is
begin
return Node.Right;
end Right;
---------------
-- Set_Color --
---------------
procedure Set_Color (Node : Node_Access; Color : Color_Type) is
begin
Node.Color := Color;
end Set_Color;
--------------
-- Set_Left --
--------------
procedure Set_Left (Node : Node_Access; Left : Node_Access) is
begin
Node.Left := Left;
end Set_Left;
----------------
-- Set_Parent --
----------------
procedure Set_Parent (Node : Node_Access; Parent : Node_Access) is
begin
Node.Parent := Parent;
end Set_Parent;
---------------
-- Set_Right --
---------------
procedure Set_Right (Node : Node_Access; Right : Node_Access) is
begin
Node.Right := Right;
end Set_Right;
--------------------
-- Update_Element --
--------------------
procedure Update_Element
(Position : Cursor;
Process : not null access procedure (Element : in out Element_Type))
is
begin
Process (Position.Node.Key.all, Position.Node.Element.all);
end Update_Element;
-----------
-- Write --
-----------
procedure Write
(Stream : access Root_Stream_Type'Class;
Container : Map)
is
procedure Process (Node : Node_Access);
pragma Inline (Process);
procedure Iterate is
new Tree_Operations.Generic_Iteration (Process);
-------------
-- Process --
-------------
procedure Process (Node : Node_Access) is
begin
Key_Type'Output (Stream, Node.Key.all);
Element_Type'Output (Stream, Node.Element.all);
end Process;
-- Start of processing for Write
begin
Count_Type'Base'Write (Stream, Container.Tree.Length);
Iterate (Container.Tree);
end Write;
end Ada.Containers.Indefinite_Ordered_Maps;
^ permalink raw reply [relevance 6%]
* Re: Ada.Containers.Indefinite_Ordered_Maps of gcc 4.0.1 has bug ?
2005-08-06 11:57 14% Ada.Containers.Indefinite_Ordered_Maps of gcc 4.0.1 has bug ? Y.Tomino
@ 2005-08-06 12:54 6% ` Matthew Heaney
2005-08-06 13:13 6% ` Y.Tomino
[not found] ` <42F4B753.2080004@panathenaia.halfmoon.jp>
0 siblings, 2 replies; 26+ results
From: Matthew Heaney @ 2005-08-06 12:54 UTC (permalink / raw)
"Y.Tomino" <demoonlit@panathenaia.halfmoon.jp> writes:
> Ada.Containers.Indefinite_Ordered_Maps.Adjust seems to me having bug.
> Although good if it's my misunderstanding.
I just ran your examples, and didn't get any exceptions.
It might be the case that you're using an older version of the sources.
Can you go into your adainclude directory, and send me your copies of
a-ciorma.ad?. (That, or send me the context around line 407.)
-Matt
^ permalink raw reply [relevance 6%]
* Ada.Containers.Indefinite_Ordered_Maps of gcc 4.0.1 has bug ?
@ 2005-08-06 11:57 14% Y.Tomino
2005-08-06 12:54 6% ` Matthew Heaney
0 siblings, 1 reply; 26+ results
From: Y.Tomino @ 2005-08-06 11:57 UTC (permalink / raw)
Hello.
Ada.Containers.Indefinite_Ordered_Maps.Adjust seems to me having bug.
Although good if it's my misunderstanding.
pragma Ada_05;
with Ada.Containers.Indefinite_Ordered_Maps;
package M is new Ada.Containers.Indefinite_Ordered_Maps(String, String);
pragma Ada_05;
with Ada.Text_IO; use Ada.Text_IO;
with m; use M;
procedure Test1 is
X, Y : Map;
begin
X.Include("a", "1");
Put_Line(Element(X, "a")); -- "1" OK
Y := X;
Put_Line(Element(Y, "a")); -- "1" OK
Clear(X);
Put_Line(Element(Y, "a"));
-- raised CONSTRAINT_ERROR : a-ciorma.adb:407 access check failed !?
end Test1;
pragma Ada_05;
with Ada.Text_IO; use Ada.Text_IO;
with m; use M;
procedure Test2 is
function X return Map is
R : Map;
begin
R.Include("a", "1");
return R;
end X;
Y : Map := X;
begin
Put_Line(Element(Y, "a"));
-- raised CONSTRAINT_ERROR : a-ciorma.adb:407 access check failed !?
end Test2;
YT
^ permalink raw reply [relevance 14%]
* Re: Teaching new tricks to an old dog (C++ -->Ada)
@ 2005-03-24 1:58 5% ` Matthew Heaney
0 siblings, 0 replies; 26+ results
From: Matthew Heaney @ 2005-03-24 1:58 UTC (permalink / raw)
Ioannis Vranos <ivr@remove.this.grad.com> writes:
> I think an associative container like map fits better to this. What do
> you do in Ada if you want to associate product names with prices, in
> the style:
>
> productlist["something"]= 71.2;
Ada 2005 comes with a standard container library, very similar to the
C++ STL. For example:
declare
package Map_Types is
new Ada.Containers.Indefinite_Ordered_Maps
(String,
Float);
M : Map_Types.Map;
begin
M.Include (Key => "something", New_Item => 71.2);
end;
There's also a standard hashed map.
> or a name with a number (string with string) in an address book
> application for example?
>
>
> namelist["Obry Pascal"]="321-45563";
See above. The element type in this case is String instead of Float.
> Also may you tell me if that famous compile-time boundary checking
> applies (can be used) to user-defined containers too?
I guess the answer is yes, since subtype constraints are inherited from
generic actual types. For example, if we have:
type My_Float is new Float range 0.0 .. 42.0;
and you instantiate the map with My_Float, then you'll get
Constraint_Error if you attempt to insert a float value outside the
range of the subtype.
-Matt
^ permalink raw reply [relevance 5%]
* Re: Bye, bye?
@ 2005-02-09 19:04 6% ` mheaney
0 siblings, 0 replies; 26+ results
From: mheaney @ 2005-02-09 19:04 UTC (permalink / raw)
Wes Groleau wrote:
>
> But much of what I do depends on hashes
> (associative arrays), which are built-in to perl.
> Plus I attach the hash to a DBM file.
>
> To do that in Ada, I'd have to not only upgrade Xcode
> (not an option right now) and install Ada (easy, but
> requires Xcode), but I'd also have to find or build
> a hash package (not hard) and/or a DBM binding (a little
> harder).
Associative arrays will be included in the next version of Ada, as part
of the standard container library:
ada.containers.hashed_maps
ada.containers.indefinite_hashed_maps
There will also be an ordered version (which does the same thing as the
hashed version, but with a different time complexity; it's also a bit
simpler to instantiate):
ada.containers.ordered_maps
ada.containers.indefinite_ordered_maps
There are also hashed and ordered sets (for use when you don't need a
separate key and element).
You can get a reference implementation in the ai302 subdirectory at the
charles.tigris.org website.
Look for the files named a-c*.ad[sb] .
-Matt
^ permalink raw reply [relevance 6%]
Results 1-26 of 26 | reverse | options above
-- pct% links below jump to the message on this page, permalinks otherwise --
2005-02-02 2:48 Bye, bye? Wes Groleau
2005-02-02 21:12 ` Ludovic Brenta
2005-02-03 4:24 ` Wes Groleau
2005-02-09 19:04 6% ` mheaney
2005-03-05 13:42 Teaching new tricks to an old dog (C++ -->Ada) Turamnvia Suouriviaskimatta
2005-03-05 14:17 ` EventHelix.com
2005-03-05 14:25 ` Ludovic Brenta
2005-03-05 15:02 ` [OT] " Peter Koch Larsen
2005-03-05 15:39 ` Ludovic Brenta
2005-03-05 19:48 ` Ioannis Vranos
2005-03-06 1:01 ` Martin Dowie
2005-03-08 12:14 ` Hans Malherbe
2005-03-08 15:31 ` Peter Amey
2005-03-08 18:16 ` Pascal Obry
2005-03-09 0:44 ` Ioannis Vranos
2005-03-09 8:52 ` Pascal Obry
2005-03-09 9:49 ` Ioannis Vranos
2005-03-09 11:17 ` Georg Bauhaus
2005-03-09 14:24 ` Falk Tannhäuser
2005-03-22 1:43 ` adaworks
2005-03-22 4:02 ` Ioannis Vranos
2005-03-22 9:49 ` Georg Bauhaus
2005-03-22 20:03 ` Ioannis Vranos
2005-03-22 22:00 ` Georg Bauhaus
2005-03-23 9:00 ` Ioannis Vranos
2005-03-23 9:11 ` Pascal Obry
2005-03-23 10:09 ` Ioannis Vranos
2005-03-23 10:16 ` Pascal Obry
2005-03-23 10:36 ` Ioannis Vranos
2005-03-24 1:58 5% ` Matthew Heaney
2005-08-06 11:57 14% Ada.Containers.Indefinite_Ordered_Maps of gcc 4.0.1 has bug ? Y.Tomino
2005-08-06 12:54 6% ` Matthew Heaney
2005-08-06 13:13 6% ` Y.Tomino
[not found] ` <42F4B753.2080004@panathenaia.halfmoon.jp>
2005-08-06 15:37 5% ` Matthew Heaney
2005-08-06 16:17 5% ` Y.Tomino
2005-08-06 16:33 6% ` Matthew Heaney
2005-08-06 16:49 6% ` Y.Tomino
2005-08-13 0:43 Hash table David Trudgett
2005-08-13 23:58 5% ` Matthew Heaney
2006-11-21 10:11 How to use associative arrays in Ada 2005? snoopysalive
2006-11-21 14:18 5% ` Matthew Heaney
2014-08-05 20:09 A bad counterintuitive behaviour of Ada about OO Victor Porton
2014-08-05 20:59 ` Dmitry A. Kazakov
2014-08-05 21:11 ` Victor Porton
2014-08-06 7:26 ` Dmitry A. Kazakov
2014-08-07 7:41 ` Maciej Sobczak
2014-08-07 8:58 ` J-P. Rosen
2014-08-07 9:40 ` Dmitry A. Kazakov
2014-08-07 11:17 ` J-P. Rosen
2014-08-07 12:28 ` Dmitry A. Kazakov
2014-08-07 13:34 ` J-P. Rosen
2014-08-07 20:29 ` Shark8
2014-08-08 7:49 ` J-P. Rosen
2014-08-08 8:12 ` Shark8
2014-08-08 8:26 ` Dmitry A. Kazakov
2014-08-08 11:10 ` Shark8
2014-08-08 11:20 ` Dmitry A. Kazakov
2014-08-08 19:34 3% ` Shark8
2015-04-17 13:42 7% Interesting containers problem Shark8
2016-08-23 17:15 4% How do I get an enctry in a protected object to block until a certain item arrives from a producer task? john
2016-09-21 22:05 New to Ada need help implementing Warshall's algorithm James Brewer
2016-09-23 4:31 6% ` Shark8
2016-09-23 6:26 ` Simon Wright
2016-09-23 15:07 ` James Brewer
2016-09-25 16:06 ` Stephen Leake
2016-09-26 20:40 6% ` Simon Wright
2016-09-23 14:54 0% ` James Brewer
2018-09-19 13:12 5% Ada.Containers and concurrent modification exception rakusu_klein
2018-09-19 15:22 0% ` Jacob Sparre Andersen
2018-09-19 15:53 0% ` Simon Wright
2018-09-19 20:16 0% ` Jeffrey R. Carter
2020-08-06 18:40 Newbie question # 2 Ian Douglas
2020-08-06 18:56 6% ` Simon Wright
2020-08-06 19:41 0% ` Ian Douglas
2020-09-11 10:37 Visibility issue Daniel
2020-09-17 21:47 4% ` Shark8
2021-02-20 15:26 set_index and and end_of_file with just a stream reference Mehdi Saada
2021-02-20 16:04 ` Dmitry A. Kazakov
2021-02-20 16:22 ` Mehdi Saada
2021-02-20 16:30 ` Mehdi Saada
2021-02-20 17:59 ` Dmitry A. Kazakov
2021-02-20 19:08 ` Mehdi Saada
2021-02-23 17:21 5% ` Shark8
2021-03-12 20:49 array from static predicate on enumerated type Matt Borchers
2021-03-12 22:41 ` Dmitry A. Kazakov
2021-03-13 2:06 ` Matt Borchers
2021-03-13 4:55 ` Randy Brukardt
2021-03-15 14:16 ` Matt Borchers
2021-03-15 17:53 5% ` Shark8
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox