comp.lang.ada
 help / color / mirror / Atom feed
Search results ordered by [date|relevance]  view[summary|nested|Atom feed]
thread overview below | download mbox.gz: |
* Re: GNAT Community 2020 (20200818-93): Big_Integer
  @ 2023-06-30 21:07  5% ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2023-06-30 21:07 UTC (permalink / raw)


On 2023-06-30 21:28, Frank Jørgen Jørgensen wrote:

> I'm running the below program with GNAT Community 2020 (20200818-93)
> on Windows 11 Home.
> I have some problems trying to save big numbers to a file - so I noticed this behaviour:
> If I open Test.dat in Visual Studio Hex editor,  it seems like this program saves this big number with a different bit pattern each time.
> Is that as expected?
> I do have some problems reading back the big numbers in my real code.
> When I compile I get the warning: "Ada.Numerics.Big_Numbers.Big_Integers"  is an Ada 202x unit.
> 
> --
> with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
> with Ada.Numerics.Big_Numbers.Big_Integers;
> 
> procedure Test is
> 
>        B1 : Ada.Numerics.Big_Numbers.Big_Integers.Big_Integer;
>        F1 : File_Type;
>        S1 : Stream_Access;
>     begin
>        B1 := 1;
> 
>        Ada.Streams.Stream_IO.Create (F1, Out_File, "Test.dat");
>        S1 := Ada.Streams.Stream_IO.Stream (F1);
>        Ada.Numerics.Big_Numbers.Big_Integers.Big_Integer'Write(S1, B1);
>        Ada.Numerics.Big_Numbers.Big_Integers.Big_Integer'Output(S1, B1);
>        Ada.Streams.Stream_IO.Close (F1);
> end Test;

As a general rule, you should never use predefined implementations of 
stream attributes except for Stream_Element or Character. Anything else 
you must always override or else not use.

If you want to serialize signed integers use some portable format for 
it. E.g. a chained encoding.

Here is a test program for a straightforward implementation of chained 
store/restore:
-------------------------
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
with Ada.Numerics.Big_Numbers.Big_Integers;
with Ada.Exceptions;
with Ada.IO_Exceptions;

procedure Test is

    use Ada.Streams;
    use Ada.Numerics.Big_Numbers.Big_Integers;
    use Ada.Exceptions;
    use Ada.Streams.Stream_IO;

    Two : constant Big_Integer := To_Big_Integer (2);

    package Conversions is new Unsigned_Conversions (Stream_Element);
    use Conversions;

    function Get
             (  Stream : in out Root_Stream_Type'Class
             )  return Big_Integer is
       Result   : Big_Integer;
       Power    : Natural := 6;
       Negative : Boolean;
       Buffer   : Stream_Element_Array (1..1);
       Last     : Stream_Element_Offset;
       This     : Stream_Element renames Buffer (1);
    begin
       Stream.Read (Buffer, Last);
       if Last /= 1 then
          raise End_Error;
       end if;
       Result   := To_Big_Integer ((This and 2#0111_1110#) / 2);
       Negative := 0 /= (This and 1);
       if 0 = (This and 16#80#) then
          if Negative then
             return -Result - 1;
          else
             return Result;
          end if;
       end if;
       loop
          Stream.Read (Buffer, Last);
          if Last /= 1 then
             raise End_Error;
          end if;
          Result := Result +
             Two**Power * To_Big_Integer (This and 16#7F#);
          if 0 = (This and 16#80#) then
             if Negative then
                return -Result - 1;
             else
                return Result;
             end if;
          end if;
          Power := Power + 7;
       end loop;
    end Get;

    procedure Put
              (  Stream : in out Root_Stream_Type'Class;
                 Value  : Big_Integer
              )  is
       Item   : Big_Integer := Value;
       Buffer : Stream_Element_Array (1..1);
       This   : Stream_Element renames Buffer (1);
    begin
       if Item >= 0 then
          Item := Value;
          This := From_Big_Integer (Item mod (16#40#)) * 2;
       else
          Item := -(Value + 1);
          This := From_Big_Integer (Item mod (16#40#)) * 2 + 1;
       end if;
       Item := Item / 16#40#;
       if Item = 0 then
          Stream.Write (Buffer);
          return;
       end if;
       This := This or 16#80#;
       Stream.Write (Buffer);
       loop
          This := From_Big_Integer (Item mod 16#80#) or 16#80#;
          Item := Item / 16#80#;
          if Item = 0 then
             This := This and 16#7F#;
             Stream.Write (Buffer);
             return;
          end if;
          Stream.Write (Buffer);
       end loop;
    end Put;

    F : File_Type;
begin
    Create (F, Out_File, "Test.dat");
    for I in -1_000_000..1_000_000 loop
       Put (Stream (F).all, To_Big_Integer (I));
    end loop;
    Close (F);
    Open (F, In_File, "Test.dat");
    for I in -1_000_000..1_000_000 loop
       declare
          Value : constant Big_Integer := Get (Stream (F).all);
       begin
          if Value /= To_Big_Integer (I) then
             raise Data_Error;
          end if;
       end;
    end loop;
    Close (F);
end Test;
-------------------------
The above could be optimized to work with buffers rather than 
reading/writing stream octets one by one. It is a long story, but 
normally you would implement some data blocks with the length count on 
top of the stream in order to avoid inefficient octet by octet reading 
and add an error correction layer.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 5%]

* Re: Ada and Unicode
  2023-03-31  3:06  0%               ` Thomas
@ 2023-04-01 10:18  0%                 ` Randy Brukardt
  0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2023-04-01 10:18 UTC (permalink / raw)


I'm not going to answer this point-by-point, as it would take very much too 
long, and there is a similar thread going on the ARG's Github (which needs 
my attention more than comp.lang.ada.

But my opinion is that Ada got strings completely wrong, and the best thing 
to do with them is to completely nuke them and start over. But one cannot do 
that in the context of Ada, one would have to at least leave way to use the 
old mechanisms for compatibility with older code. That would leave a 
hodge-podge of mechanisms that would make Ada very much harder (rather than 
easier) to use.

As far as the cruft goes, I wrote up a 20+ page document on that during the 
pandemic, but I could never interest anyone knowledgeable to review it, and 
I don't plan to make it available without that. Most of the things are 
caused by interactions -- mostly because of too much generality. And of 
course there are features that Ada would be better off without (like 
anonymous access types).

                          Randy.

"Thomas" <fantome.forums.tDeContes@free.fr.invalid> wrote in message 
news:64264e2f$0$25952$426a74cc@news.free.fr...
> In article <t2g0c1$eou$1@dont-email.me>,
> "Randy Brukardt" <randy@rrsoftware.com> wrote:
>
>> "Thomas" <fantome.forums.tDeContes@free.fr.invalid> wrote in message
>> news:fantome.forums.tDeContes-5E3B70.20370903042022@news.free.fr...
>> ...
>> > as i said to Vadim Godunko, i need to fill a string type with an UTF-8
>> > litteral.but i don't think this string type has to manage various
>> > conversions.
>> >
>> > from my point of view, each library has to accept 1 kind of string type
>> > (preferably UTF-8 everywhere),
>> > and then, this library has to make needed conversions regarding the
>> > underlying API. not the user.
>>
>> This certainly is a fine ivory tower solution,
>
> I like to think from an ivory tower,
> and then look at the reality to see what's possible to do or not. :-)
>
>
>
>> but it completely ignores two
>> practicalities in the case of Ada:
>>
>> (1) You need to replace almost all of the existing Ada language defined
>> packages to make this work. Things that are deeply embedded in both
>> implementations and programs (like Ada.Exceptions and Ada.Text_IO) would
>> have to change substantially. The result would essentially be a different
>> language, since the resulting libraries would not work with most existing
>> programs.
>
> - in Ada, of course we can't delete what's existing, and there are many
> packages which are already in 3 versions (S/WS/WWS).
> imho, it would be consistent to make a 4th version of them for a new
> UTF_8_String type.
>
> - in a new language close to Ada, it would not necessarily be a good
> idea to remove some of them, depending on industrial needs, to keep them
> with us.
>
>> They'd have to have different names (since if you used the same
>> names, you change the failures from compile-time to runtime -- or even
>> undetected -- which would be completely against the spirit of Ada), which
>> means that one would have to essentially start over learning and using 
>> the
>> resulting language.
>
> i think i don't understand.
>
>> (and it would make sense to use this point to
>> eliminate a lot of the cruft from the Ada design).
>
> could you give an example of cruft from the Ada design, please? :-)
>
>
>>
>> (2) One needs to be able to read and write data given whatever encoding 
>> the
>> project requires (that's often decided by outside forces, such as other
>> hardware or software that the project needs to interoperate with).
>
>> At a minimum, you
>> have to have a way to specify the encoding of files, streams, and 
>> hardware
>> interfaces
>
>> That will greatly complicate the interface and
>> implementation of the libraries.
>
> i don't think so.
> it's a matter of interfacing libraries, for the purpose of communicating
> with the outside (neither of internal libraries nor of the choice of the
> internal type for the implementation).
>
> Ada.Text_IO.Open.Form already allows (a part of?) this (on the content
> of the files, not on their name), see ARM A.10.2 (6-8).
> (write i the reference to ARM correctly?)
>
>
>
>>
>> > ... of course, it would be very nice to have a more thicker language 
>> > with
>> > a garbage collector ...
>>
>> I doubt that you will ever see that in the Ada family,
>
>> as analysis and
>> therefore determinism is a very important property for the language.
>
> I completely agree :-)
>
>> Ada has
>> lots of mechanisms for managing storage without directly doing it 
>> yourself
>> (by calling Unchecked_Deallocation), yet none of them use any garbage
>> collection in a traditional sense.
>
> sorry, i meant "garbage collector" in a generic sense, not in a
> traditional sense.
> that is, as Ada users we could program with pointers and pool, without
> memory leaks nor calling Unchecked_Deallocation.
>
> for example Ada.Containers.Indefinite_Holders.
>
> i already wrote one for constrained limited types.
> do you know if it's possible to do it for unconstrained limited types,
> like the class of a limited tagged type?
>
> -- 
> RAPID maintainer
> http://savannah.nongnu.org/projects/rapid/ 


^ permalink raw reply	[relevance 0%]

* Re: Ada and Unicode
  2022-04-04 23:52  3%             ` Randy Brukardt
@ 2023-03-31  3:06  0%               ` Thomas
  2023-04-01 10:18  0%                 ` Randy Brukardt
  0 siblings, 1 reply; 200+ results
From: Thomas @ 2023-03-31  3:06 UTC (permalink / raw)


In article <t2g0c1$eou$1@dont-email.me>,
 "Randy Brukardt" <randy@rrsoftware.com> wrote:

> "Thomas" <fantome.forums.tDeContes@free.fr.invalid> wrote in message 
> news:fantome.forums.tDeContes-5E3B70.20370903042022@news.free.fr...
> ...
> > as i said to Vadim Godunko, i need to fill a string type with an UTF-8
> > litteral.but i don't think this string type has to manage various 
> > conversions.
> >
> > from my point of view, each library has to accept 1 kind of string type
> > (preferably UTF-8 everywhere),
> > and then, this library has to make needed conversions regarding the
> > underlying API. not the user.
> 
> This certainly is a fine ivory tower solution,

I like to think from an ivory tower, 
and then look at the reality to see what's possible to do or not. :-)



> but it completely ignores two 
> practicalities in the case of Ada:
> 
> (1) You need to replace almost all of the existing Ada language defined 
> packages to make this work. Things that are deeply embedded in both 
> implementations and programs (like Ada.Exceptions and Ada.Text_IO) would 
> have to change substantially. The result would essentially be a different 
> language, since the resulting libraries would not work with most existing 
> programs.

- in Ada, of course we can't delete what's existing, and there are many 
packages which are already in 3 versions (S/WS/WWS).
imho, it would be consistent to make a 4th version of them for a new 
UTF_8_String type.

- in a new language close to Ada, it would not necessarily be a good 
idea to remove some of them, depending on industrial needs, to keep them 
with us.

> They'd have to have different names (since if you used the same 
> names, you change the failures from compile-time to runtime -- or even 
> undetected -- which would be completely against the spirit of Ada), which 
> means that one would have to essentially start over learning and using the 
> resulting language.

i think i don't understand.

> (and it would make sense to use this point to 
> eliminate a lot of the cruft from the Ada design).

could you give an example of cruft from the Ada design, please? :-)


> 
> (2) One needs to be able to read and write data given whatever encoding the 
> project requires (that's often decided by outside forces, such as other 
> hardware or software that the project needs to interoperate with).

> At a minimum, you 
> have to have a way to specify the encoding of files, streams, and hardware 
> interfaces

> That will greatly complicate the interface and 
> implementation of the libraries.

i don't think so.
it's a matter of interfacing libraries, for the purpose of communicating 
with the outside (neither of internal libraries nor of the choice of the 
internal type for the implementation).

Ada.Text_IO.Open.Form already allows (a part of?) this (on the content 
of the files, not on their name), see ARM A.10.2 (6-8).
(write i the reference to ARM correctly?)



> 
> > ... of course, it would be very nice to have a more thicker language with 
> > a garbage collector ...
> 
> I doubt that you will ever see that in the Ada family,

> as analysis and 
> therefore determinism is a very important property for the language.

I completely agree :-)

> Ada has 
> lots of mechanisms for managing storage without directly doing it yourself 
> (by calling Unchecked_Deallocation), yet none of them use any garbage 
> collection in a traditional sense.

sorry, i meant "garbage collector" in a generic sense, not in a 
traditional sense.
that is, as Ada users we could program with pointers and pool, without 
memory leaks nor calling Unchecked_Deallocation.

for example Ada.Containers.Indefinite_Holders.

i already wrote one for constrained limited types.
do you know if it's possible to do it for unconstrained limited types, 
like the class of a limited tagged type?

-- 
RAPID maintainer
http://savannah.nongnu.org/projects/rapid/

^ permalink raw reply	[relevance 0%]

* Re: Real_Arrays on heap with overloaded operators and clean syntax
  @ 2023-01-22 23:53  4%       ` Joakim Strandberg
  0 siblings, 0 replies; 200+ results
From: Joakim Strandberg @ 2023-01-22 23:53 UTC (permalink / raw)


måndag 23 januari 2023 kl. 00:34:31 UTC+1 skrev roda...@gmail.com:
> On 23/1/23 10:20, Jim Paloander wrote: 
> >>> Dear ADA lovers, 
> >>> with stack allocation of Real_Vector ( 1 .. N ) when N >= 100,000 I get STACK_OVERFLOW ERROR while trying to check how fast operator overloading is working for an expression 
> >>> 
> >>> X := A + B + C + C + A + B, where 
> >>> A,B,C,X are all Real_Vector ( 1 .. N ). 
> >>> 
> >>> So my only option was to allocate on the heap using new. But then I lost the clean syntax 
> >>> 
> >>> X := A + B + C + C + A + B 
> >>> 
> >>> and I had to write instead: 
> >>> 
> >>> X.all := A.all + B.all + C.all + C.all + A.all + B.all. 
> >>> 
> >>> This is really ugly and annoying because when you are using Real_Arrays for implementing some linear algebra method who relies heavilly on matrix vector products and vector updates, you do need to allocate on the heap (sizes are determined in runtime) and you do need a clean syntax. So, is there any way to simplify my life without using the .all or even without declaring A,B,C,X as access Real_Vector? 
> >>> Thanks for your time! 
> >> If you are on linux, then you could set the stack size with 
> >> 
> >> $ ulimit -s unlimited 
> >> $ launch_my_app 
> >> 
> >> 
> >> 
> >> Regards. 
> > On Windows 10 with mingw64?
> Not sure. I don't have a windows machine. 
> 
> What happens when try ? 
> 
> $ ulimit -a

Something came up and I had to send my previous reply/e-mail as is. I wanted to find the video where Jean Pierre Rosen talks about how memory is handled in the Ada language from FOSDEM perhaps 2018-2019. Unfortunately I have been unable to find it.

Secondly, example of Ada code where Storage pool usage is demonstrated: https://github.com/joakim-strandberg/advent_of_code

Example of task with rendez-vous mechanism:
task T with Storage_Size => 10_000_000 is
   entry Run (I : Integer);
end T;

task body T is
begin
   loop
       begin
           select
                accept Run (I : Integer) do
                     null;  --  Here save the value of the integer I for later processing in the task
                end Run;
                null;  -- Whenever another task calls Run on this task, the work to be done should be put here.
               -- Put the mathematical calcuations here.
           or
                terminate;  --  To end the select-statement with "or terminate;" means the task will terminate when the environment task has finished execution of the "Main" procedure of the application. No need to tell the task T that now it is time to shutdown.
           end select;
       exception
            when Error : others =>
              -- Print error to standard out here using subprograms from Ada.Exceptions and Ada.Text_IO.
       end;
   end loop;
end T; 

Best regards,
Joakim

^ permalink raw reply	[relevance 4%]

* Re: Exceptions Not Working Under High Sierra
  2022-10-23  6:33  0% ` Simon Wright
@ 2022-10-23 10:57  0%   ` Roger Mc
  0 siblings, 0 replies; 200+ results
From: Roger Mc @ 2022-10-23 10:57 UTC (permalink / raw)


On Sunday, October 23, 2022 at 5:34:07 PM UTC+11, Simon Wright wrote:
> Roger Mc <roge...@gmail.com> writes: 
> 
> > OSX 10.13.6 
> > Xcode 10.1 
> > GNAT Community 2021 (20210519) 
> > 
> > On my MacBook Air which is restricted to OSX 10.13.6 Ada Exceptions produce 
> > Execution terminated by abort of environment task 
> > instead of the standard exception message 
> > I reinstalled Command Line Tools but this didn't improve matters. 
> > 
> > Any advice on overcoming this problem will be appreciated.
> Does your project by any chance involve C++? I had problems related to 
> clang++ vs g++ which I wrote up here: 
> https://forward-in-code.blogspot.com/2022/03/gnat-llvm.html

No C++ code but interfaces to C via pragmas

GPS 19.1 (20190106) hosted on x86_64-apple-darwin16.7.0

^ permalink raw reply	[relevance 0%]

* Re: Exceptions Not Working Under High Sierra
  2022-10-23  4:36  5% Exceptions Not Working Under High Sierra Roger Mc
@ 2022-10-23  6:33  0% ` Simon Wright
  2022-10-23 10:57  0%   ` Roger Mc
  0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2022-10-23  6:33 UTC (permalink / raw)


Roger Mc <rogermcm2@gmail.com> writes:

> OSX 10.13.6
> Xcode 10.1
> GNAT Community 2021 (20210519)
>
> On my MacBook Air which is restricted to OSX 10.13.6 Ada Exceptions produce 
> Execution terminated by abort of environment task
> instead of the standard exception message
> I reinstalled Command Line Tools but this didn't improve matters.
>
> Any advice on overcoming this problem will be appreciated.

Does your project by any chance involve C++? I had problems related to
clang++ vs g++ which I wrote up here:
https://forward-in-code.blogspot.com/2022/03/gnat-llvm.html

^ permalink raw reply	[relevance 0%]

* Exceptions Not Working Under High Sierra
@ 2022-10-23  4:36  5% Roger Mc
  2022-10-23  6:33  0% ` Simon Wright
  0 siblings, 1 reply; 200+ results
From: Roger Mc @ 2022-10-23  4:36 UTC (permalink / raw)


OSX 10.13.6
Xcode 10.1
GNAT Community 2021 (20210519)

On my MacBook Air which is restricted to OSX 10.13.6 Ada Exceptions produce 
Execution terminated by abort of environment task
instead of the standard exception message
I reinstalled Command Line Tools but this didn't improve matters.

Any advice on overcoming this problem will be appreciated.

^ permalink raw reply	[relevance 5%]

* Re: MS going to rust (and Linux too)
  @ 2022-09-24 17:49  4%         ` G.B.
  0 siblings, 0 replies; 200+ results
From: G.B. @ 2022-09-24 17:49 UTC (permalink / raw)


On 24.09.22 15:05, Luke A. Guest wrote:
> On 24/09/2022 12:41, G.B. wrote:
> 
>> Write a really good driver for Linux using Ada 2012 and do not use
>> capital letters in the source text, at least where Linux doesn't.
>> Be silent about the language. Can an Adaist do that, to save the
>> language?
> 
> The biggest problem is that the compiled runtime is compiler version dependent and the pain of making a runtime for linux kernel dev available for each and every compiler version, remember these things can also change on a version change too.

Won't the Ada run-time need very little?
Even the full Ravenscar profile seems to offer too much,
as, for example, Linux kernel drivers need no Ada tasking
at all. Would I want Ada exceptions in drivers?
And to hell with Ada Strings and non-kernel I/O ;-)

If a "kernel-profiled" flavor of protected types will be
an interesting approach to handling events and race
conditions, by basing protected objects on kernel primitives,
then I imagine their implementation to be another nice one
_not_ to brag about, but to just use. Every language is adding
"await" and "async", Java has gone lower than "synchronized"
many versions ago. Every language is not just catching up,
from users' POV...

Ada 2022 is full of popular niceties (cf. "Ada 2022 Overview posted").
Combine them with added insight into program properties
when using SPARK and similar features. The resulting language
needs no mention of the name "Ada" at all in order to be convincing.

^ permalink raw reply	[relevance 4%]

* Is this an error in compiler?
@ 2022-09-11  7:27  4% reinert
  0 siblings, 0 replies; 200+ results
From: reinert @ 2022-09-11  7:27 UTC (permalink / raw)


Hello,

I tried alire with the latest version of the compiler (I believe) and I got trouble
compiling this program (which I here have reduced just to communicate my 
point - i.e. the program has no other meaning here):
--------------------------------------------------------------------------------------------
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;

procedure c0a is

subtype String_1 is String (1 .. <>);

package cpros is
cfe0,cfe1,cfe2 : exception;
generic
with procedure execute_command1 (command1 : String);
procedure cpros0
(file1 : in Ada.Text_IO.File_Type; command0 : String := "");
end cpros;

package body cpros is

procedure cpros0 (file1 : in Ada.Text_IO.File_Type; command0 : String := "")
is
begin
declare
function rep1 (str0 : String_1) return String is
i : constant Natural := Index (str0, "$");
begin
return str0 when i = 0;
-- raise cfe2 with "(wrong use of '$')" when i = str0'Last; -- a
if i = str0'Last then -- b
raise cfe2 with "(wrong use of '$')"; -- b
end if; -- b
return "aaa";
end rep1;
str0 : constant String := rep1 (Get_Line (file1));
begin
null;
end;
end cpros0;
end cpros;

procedure execute_command1 (str : String) is
begin
null;
end execute_command1;

procedure cpros1 is new cpros.cpros0 (execute_command1 => execute_command1);

begin
null;
end c0a;
-----------------------------------------------------------------------------------------------
This goes through when I compile it.

However, if I uncomment the "a" line and comment out the alternative "b" line 
(see code above), then I get the error message:

c0a.adb:45:04: error: instantiation error at line 27
c0a.adb:45:04: error: "cfe2" is not visible
c0a.adb:45:04: error: instantiation error at line 27
c0a.adb:45:04: error: non-visible declaration at line 10

Have you the same experience?

reinert

^ permalink raw reply	[relevance 4%]

* Is this an error in compiler?
@ 2022-09-11  7:21  4% reinert
  0 siblings, 0 replies; 200+ results
From: reinert @ 2022-09-11  7:21 UTC (permalink / raw)


Hello,

I tried alire with the latest version of the compiler (I believe) and I got trouble
compiling this program (which I here have reduced just to communicate my point - i.e. the program has noe other meaning here):
--------------------------------------------------------------------------------------------
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;

procedure c0a is

subtype String_1 is String (1 .. <>);

package cpros is
cfe0,cfe1,cfe2 : exception;
generic
with procedure execute_command1 (command1 : String);
procedure cpros0
(file1 : in Ada.Text_IO.File_Type; command0 : String := "");
end cpros;

package body cpros is

procedure cpros0 (file1 : in Ada.Text_IO.File_Type; command0 : String := "")
is
begin
declare
function rep1 (str0 : String_1) return String is
i : constant Natural := Index (str0, "$");
begin
return str0 when i = 0;
-- raise cfe2 with "(wrong use of '$')" when i = str0'Last; -- a
if i = str0'Last then -- b
raise cfe2 with "(wrong use of '$')"; -- b
end if; -- b
return "aaa";
end rep1;
str0 : constant String := rep1 (Get_Line (file1));
begin
null;
end;
end cpros0;
end cpros;

procedure execute_command1 (str : String) is
begin
null;
end execute_command1;

procedure cpros1 is new cpros.cpros0 (execute_command1 => execute_command1);

begin
null;
end c0a;
-----------------------------------------------------------------------------------------------
This goes through when I compile it.

However, if I uncomment out the "a" line and comment out the "b" line (see code above), then I get the error message:

c0a.adb:45:04: error: instantiation error at line 27
c0a.adb:45:04: error: "cfe2" is not visible
c0a.adb:45:04: error: instantiation error at line 27
c0a.adb:45:04: error: non-visible declaration at line 10

Have you the same experience?

reinert

^ permalink raw reply	[relevance 4%]

* Is this an error in compiler
@ 2022-09-11  7:19  4% reinert
  0 siblings, 0 replies; 200+ results
From: reinert @ 2022-09-11  7:19 UTC (permalink / raw)


Hello,

I tried alire with the latest version of the compiler (I believe) and I got trouble
compiling this program (which I here have reduced just to communicate my point - i.e. the program has no other meaning here):
--------------------------------------------------------------------------------------------
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;

procedure c0a is

subtype String_1 is String (1 .. <>);

package cpros is
cfe0,cfe1,cfe2 : exception;
generic
with procedure execute_command1 (command1 : String);
procedure cpros0
(file1 : in Ada.Text_IO.File_Type; command0 : String := "");
end cpros;

package body cpros is

procedure cpros0 (file1 : in Ada.Text_IO.File_Type; command0 : String := "")
is
begin
declare
function rep1 (str0 : String_1) return String is
i : constant Natural := Index (str0, "$");
begin
return str0 when i = 0;
raise cfe2 with "(wrong use of '$')" when i = str0'Last; -- a
-- if i = str0'Last then -- b
-- raise cfe2 with "(wrong use of '$')"; -- b
-- end if; -- b
return "aaa";
end rep1;
str0 : constant String := rep1 (Get_Line (file1));
begin
null;
end;
end cpros0;
end cpros;

procedure execute_command1 (str : String) is
begin
null;
end execute_command1;

procedure cpros1 is new cpros.cpros0 (execute_command1 => execute_command1);

begin
null;
end c0a;
-----------------------------------------------------------------------------------------------
This goes through when I compile it.

However, if I uncomment  the "a" line and comment out the "b" line (see code above), then I get the error message:

c0a.adb:45:04: error: instantiation error at line 27
c0a.adb:45:04: error: "cfe2" is not visible
c0a.adb:45:04: error: instantiation error at line 27
c0a.adb:45:04: error: non-visible declaration at line 10

Have you the same experience?

reinert

^ permalink raw reply	[relevance 4%]

* Is this an error in compiler?
@ 2022-09-11  7:16  4% reinert
  0 siblings, 0 replies; 200+ results
From: reinert @ 2022-09-11  7:16 UTC (permalink / raw)


Hello,

I tried alire with the latest version of the compiler (I believe) and I got trouble
compiling this program (which I here have reduced just to communicate my point - i.e. the program has noe other meaning here):
--------------------------------------------------------------------------------------------
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Ada.Exceptions;
with Ada.Text_IO;       use Ada.Text_IO;

procedure c0a is

subtype String_1 is String (1 .. <>);

package cpros is
   cfe0,cfe1,cfe2 : exception;
   generic
      with procedure execute_command1 (command1 : String);
   procedure cpros0
     (file1 : in Ada.Text_IO.File_Type; command0 : String := "");
end cpros;

package body cpros is

   procedure cpros0 (file1 : in Ada.Text_IO.File_Type; command0 : String := "")
   is
   begin
       declare
          function rep1 (str0 : String_1) return String is
             i : constant Natural := Index (str0, "$");
          begin
             return str0 when i = 0;
             raise cfe2 with "(wrong use of '$')" when i = str0'Last;  -- a 
        --   if i = str0'Last then                                     -- b
        --      raise cfe2 with "(wrong use of '$')";                  -- b
        --   end if;                                                   -- b
             return "aaa";
          end rep1;
          str0 : constant String := rep1 (Get_Line (file1));
       begin
         null;
       end;
   end cpros0;
end cpros;

   procedure execute_command1 (str : String) is
   begin
     null;
   end execute_command1;

   procedure cpros1 is new cpros.cpros0 (execute_command1 => execute_command1);

begin
  null;
end c0a;
-----------------------------------------------------------------------------------------------
This goes through when I compile it.

However, if I  uncomment out the "a" line and comment out the "b" line (see code above), then I get the error message:

c0a.adb:45:04: error: instantiation error at line 27
c0a.adb:45:04: error: "cfe2" is not visible
c0a.adb:45:04: error: instantiation error at line 27
c0a.adb:45:04: error: non-visible declaration at line 10

Have you the same experience?

reinert



^ permalink raw reply	[relevance 4%]

* Re: Adjust primitive not called on defaulted nonlimited controlled parameter, bug or feature ?
  2022-08-17 20:11  5% Adjust primitive not called on defaulted nonlimited controlled parameter, bug or feature ? David SAUVAGE
@ 2022-08-17 22:49  0% ` Jere
  0 siblings, 0 replies; 200+ results
From: Jere @ 2022-08-17 22:49 UTC (permalink / raw)


On Wednesday, August 17, 2022 at 4:11:46 PM UTC-4, david....@adalabs.com wrote:
> In the code extract below [2] Adjust primitive is not called on defaulted nonlimited controlled parameter Set. 
> A reproducer is available on gitlab [1] 
> 
> Seems like a bug, any feedbacks ? 
> 
> [1] 
> reproducer 
> https://gitlab.com/adalabs/reproducers/-/tree/main/adjust-not-called-on-defaulted-nonlimited-controlled-parameter 
> 
> [2] 
> 1 with Ada.Exceptions, 
> 2 Ada.Text_IO; 
> 3 
> 4 with GNAT.OS_Lib; 
> 5 
> 6 procedure Reproducer.Main is 
> 7 
> 8 -- 
> 9 -- snippet of reproducer.ads 
> 10 -- ... 
> 11 -- type Translate_Set is private; 
> 12 -- Null_Set : constant Translate_Set; 
> 13 -- private 
> 14 -- type Translate_Set is new Ada.Finalization.Controlled with record 
> 15 -- Ref_Count : Integer_Access; 
> 16 -- Set : Boolean_Access; 
> 17 -- end record; 
> 18 -- Null_Set : constant Translate_Set := (Ada.Finalization.Controlled with null, null); 
> 19 -- ... 
> 20 -- 
> 21 
> 22 procedure Process (Set : Translate_Set := Null_Set) 
> 23 is 
> 24 Content : constant String := Parse (Filename => "Process", 
> 25 Translations => Set); 
> 26 begin 
> 27 Ada.Text_IO.Put_Line (Content); 
> 28 end Process; 
> 29 begin 
> 30 Process; 
> 31 -- Ok, Initialize (Set) is not called because default value Null_Set is specified to Set (7.6 10/2). 
> 32 -- However Adjust (Set) is not called (7.6 17.8/3). 
> 33 -- Is it a feature or a bug ? 
> 34 
> 35 exception 
> 36 when E : others => 
> 37 Ada.Text_IO.Put_Line ("(FF) Adjust was not called on the nonlimited controlled object Set, when parameter defaulted to Null_Set"); 
> 38 Ada.Text_IO.Put_Line ("(FF) " & Ada.Exceptions.Exception_Information (E)); 
> 39 GNAT.OS_Lib.OS_Exit (255); 
> 40 end Reproducer.Main;

Since Translate_Set is a "by-reference type" (see section 6.2 of the RM), there isn't an 
assignment actually made is my guess.  The default parameter notation looks like assignment, but
I would hazard a guess that it doesn't mean an actual assignment is required.

^ permalink raw reply	[relevance 0%]

* Adjust primitive not called on defaulted nonlimited controlled parameter, bug or feature ?
@ 2022-08-17 20:11  5% David SAUVAGE
  2022-08-17 22:49  0% ` Jere
  0 siblings, 1 reply; 200+ results
From: David SAUVAGE @ 2022-08-17 20:11 UTC (permalink / raw)


In the code extract below [2] Adjust primitive is not called on defaulted nonlimited controlled parameter Set.
A reproducer is available on gitlab [1]

Seems like a bug, any feedbacks ?

[1] 
reproducer
https://gitlab.com/adalabs/reproducers/-/tree/main/adjust-not-called-on-defaulted-nonlimited-controlled-parameter

[2]
     1	with Ada.Exceptions,
     2	     Ada.Text_IO;
     3	
     4	with GNAT.OS_Lib;
     5	
     6	procedure Reproducer.Main is
     7	
     8	   --
     9	   --  snippet of reproducer.ads
    10	   --  ...
    11	   --     type Translate_Set is private;
    12	   --     Null_Set : constant Translate_Set;
    13	   --  private
    14	   --     type Translate_Set is new Ada.Finalization.Controlled with record
    15	   --        Ref_Count : Integer_Access;
    16	   --        Set       : Boolean_Access;
    17	   --     end record;
    18	   --     Null_Set : constant Translate_Set := (Ada.Finalization.Controlled with null, null);
    19	   --   ...
    20	   --
    21	
    22	   procedure Process (Set : Translate_Set := Null_Set)
    23	   is
    24	      Content : constant String := Parse (Filename          => "Process",
    25	                                          Translations      => Set);
    26	   begin
    27	      Ada.Text_IO.Put_Line (Content);
    28	   end Process;
    29	begin
    30	   Process;
    31	   --  Ok, Initialize (Set) is not called because default value Null_Set is specified to Set (7.6 10/2).
    32	   --  However Adjust (Set) is not called (7.6 17.8/3).
    33	   --  Is it a feature or a bug ?
    34	
    35	exception
    36	   when E : others =>
    37	      Ada.Text_IO.Put_Line ("(FF) Adjust was not called on the nonlimited controlled object Set, when parameter defaulted to Null_Set");
    38	      Ada.Text_IO.Put_Line ("(FF) " & Ada.Exceptions.Exception_Information (E));
    39	      GNAT.OS_Lib.OS_Exit (255);
    40	end Reproducer.Main;

^ permalink raw reply	[relevance 5%]

* Re: Extra information in the message string of exceptions.
  @ 2022-06-06 23:17  7%   ` Jerry
  0 siblings, 0 replies; 200+ results
From: Jerry @ 2022-06-06 23:17 UTC (permalink / raw)


On Monday, June 6, 2022 at 1:49:08 PM UTC-7, DrPi wrote:
> Le 06/06/2022 à 14:59, Rod Kay a écrit : 
> > Hi all, 
> > 
> >    Any thoughts on pro's/con's of having the Ada standard packages 
> > runtime provide extra information in the message string of exceptions ? 
> > 
> >    For instance, a Constraint_Error message might provide details on 
> > the variable name, the legal range and the erroneous value which caused 
> > the exception. 
> >
> +1 
> 
> > 
> > Regards.

This is not responsive to the OP but here is a bit of code that I find extremely useful to get a symbolic traceback for unhandled exceptions. Here is an example:

with Common; use Common;
with Ada.Exceptions;

procedure CE_2 is
    i : Positive;
    j : Integer := 1;    

    procedure A_Subroutine is
    begin
        i := -j;
    end A_Subroutine;

begin
    A_Subroutine;

    -- Print a traceback for all unhandled exceptions.
    -- See http://www.adacore.com/adaanswers/gems/gem-142-exceptions/.
    exception
    when Error : others =>
        Common.Print_Traceback_For_Unhandled_Exception(Error);
end CE_2;

It provides this output:

==========================================================
Exception name: CONSTRAINT_ERROR
Message: ce_2.adb:10 range check failed
Load address: 0x100000000
Call stack traceback locations:
0x1000013ac 0x1000013cd 0x100001c36
    <<<<<< Symbolic Traceback >>>>>>
    If incomplete, compile with -O0.
ce_2__a_subroutine.3035 (in run) (ce_2.adb:10)
_ada_ce_2 (in run) (ce_2.adb:14)
main (in run) (b__ce_2.adb:354)
==========================================================

I can post the code that does this if anyone is interested. The gist is calling Ada.Exceptions.Exception_Information, massaging that information, and calling atos. (Is atos macOS-specific?)

Jerry

^ permalink raw reply	[relevance 7%]

* Re: Ada and Unicode
  @ 2022-04-04 23:52  3%             ` Randy Brukardt
  2023-03-31  3:06  0%               ` Thomas
  0 siblings, 1 reply; 200+ results
From: Randy Brukardt @ 2022-04-04 23:52 UTC (permalink / raw)



"Thomas" <fantome.forums.tDeContes@free.fr.invalid> wrote in message 
news:fantome.forums.tDeContes-5E3B70.20370903042022@news.free.fr...
...
> as i said to Vadim Godunko, i need to fill a string type with an UTF-8
> litteral.but i don't think this string type has to manage various 
> conversions.
>
> from my point of view, each library has to accept 1 kind of string type
> (preferably UTF-8 everywhere),
> and then, this library has to make needed conversions regarding the
> underlying API. not the user.

This certainly is a fine ivory tower solution, but it completely ignores two 
practicalities in the case of Ada:

(1) You need to replace almost all of the existing Ada language defined 
packages to make this work. Things that are deeply embedded in both 
implementations and programs (like Ada.Exceptions and Ada.Text_IO) would 
have to change substantially. The result would essentially be a different 
language, since the resulting libraries would not work with most existing 
programs. They'd have to have different names (since if you used the same 
names, you change the failures from compile-time to runtime -- or even 
undetected -- which would be completely against the spirit of Ada), which 
means that one would have to essentially start over learning and using the 
resulting language. Calling it Ada would be rather silly, since it would be 
practically incompatible (and it would make sense to use this point to 
eliminate a lot of the cruft from the Ada design).

(2) One needs to be able to read and write data given whatever encoding the 
project requires (that's often decided by outside forces, such as other 
hardware or software that the project needs to interoperate with). That 
means that completely hiding the encoding (or using a universal encoding) 
doesn't fully solve the problems faced by Ada programmers. At a minimum, you 
have to have a way to specify the encoding of files, streams, and hardware 
interfaces (this sort of thing is not provided by any common target OS, so 
it's not in any target API). That will greatly complicate the interface and 
implementation of the libraries.

> ... of course, it would be very nice to have a more thicker language with 
> a garbage collector ...

I doubt that you will ever see that in the Ada family, as analysis and 
therefore determinism is a very important property for the language. Ada has 
lots of mechanisms for managing storage without directly doing it yourself 
(by calling Unchecked_Deallocation), yet none of them use any garbage 
collection in a traditional sense. I could see more such mechanisms (an 
ownership option on the line of Rust could easily manage storage at the same 
time, since any object that could be orphaned could never be used again and 
thus should be reclaimed), but standard garbage collection is too 
non-deterministic for many of the uses Ada is put to.

                                              Randy.


^ permalink raw reply	[relevance 3%]

* Re: Exception Handling within Gtkada
  2021-09-22  8:42  0%     ` ldries46
@ 2021-09-22 10:22  0%       ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2021-09-22 10:22 UTC (permalink / raw)


On 2021-09-22 10:42, ldries46 wrote:
> Op 21-9-2021 om 9:01 schreef Dmitry A. Kazakov:
>> On 2021-09-21 08:49, Vadim Godunko wrote:
>>> On Monday, September 20, 2021 at 3:06:02 PM UTC+3, ldries46 wrote:
>>>> I want an exception to be seen within an existing window of Gtkada 
>>>> to be able to see details of the error. So I used:
>>>>
>>>> exception
>>>> when no_const =>
>>>> Main_Window.Buffer.Insert_At_Cursor
>>>> ("-------------------------------------------------------------------------" 
>>>>
>>>> & To_String(CRLF));
>>>> Main_Window.Buffer.Insert_At_Cursor("Error : io_const" & 
>>>> to_String(CRLF));
>>>> end Test_Exception;
>>>>
>>>> In this case the the program ends and the reason of the exception is 
>>>> lost. I want this only for a selected nr of exceptions. In this case 
>>>> the exception no_const.
>>>
>>> Generally, Ada exceptions must not left scope of callback function. 
>>> Thus, such code should be added to each callback/event handler/etc. 
>>> subprogram of your application.
>>
>> Right. Each handler should end like this:
>>
>>    exception
>>       when Error : others =>
>>          Glib.Message.Log
>>          (  "My fancy program",
>>             Log_Level_Critical,
>>             (  "Fault in On_Button_Click: "
>>             &  Exception_Information (Error)
>>          )  );
>>    end On_Button_Click;
>>
> I tried different approaches but they cannot solve my problem. Part of 
> the problem is probably that I am developing a package which should be 
> usable in all different kind of programs maybe even under programs using 
> all different kind of GUI's.

You still may not propagate exceptions through C.

> That means that exception handling cannot 
> always be done in the package but should be done in at least a package 
> calling that problem. With this approach I tried to solve an earlier 
> problem I asked about "Is there a way to see if a value is declared as a 
> constant". I tried to solve that problem in a way that needed Exception 
> handling during running to solve a design problem that could be made. I 
> will need another way to go around that problem.

Posing a problem correctly is a half of solution.

Anyway, if you want to propagate exceptions through GTK, that is 
possible to do by marshaling and then re-raising occurrence. GtkAda 
contributions does this in the package Gtk.Main.Router. It also gives 
stack trace of the exception in a popup dialog. And it can show the 
location in GPS if that is running in the server mode.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 0%]

* Re: Exception Handling within Gtkada
  2021-09-21  7:01  0%   ` Dmitry A. Kazakov
  2021-09-21  7:24  0%     ` Emmanuel Briot
@ 2021-09-22  8:42  0%     ` ldries46
  2021-09-22 10:22  0%       ` Dmitry A. Kazakov
  1 sibling, 1 reply; 200+ results
From: ldries46 @ 2021-09-22  8:42 UTC (permalink / raw)


Op 21-9-2021 om 9:01 schreef Dmitry A. Kazakov:
> On 2021-09-21 08:49, Vadim Godunko wrote:
>> On Monday, September 20, 2021 at 3:06:02 PM UTC+3, ldries46 wrote:
>>> I want an exception to be seen within an existing window of Gtkada 
>>> to be able to see details of the error. So I used:
>>>
>>> exception
>>> when no_const =>
>>> Main_Window.Buffer.Insert_At_Cursor
>>> ("-------------------------------------------------------------------------" 
>>>
>>> & To_String(CRLF));
>>> Main_Window.Buffer.Insert_At_Cursor("Error : io_const" & 
>>> to_String(CRLF));
>>> end Test_Exception;
>>>
>>> In this case the the program ends and the reason of the exception is 
>>> lost. I want this only for a selected nr of exceptions. In this case 
>>> the exception no_const.
>>
>> Generally, Ada exceptions must not left scope of callback function. 
>> Thus, such code should be added to each callback/event handler/etc. 
>> subprogram of your application.
>
> Right. Each handler should end like this:
>
>    exception
>       when Error : others =>
>          Glib.Message.Log
>          (  "My fancy program",
>             Log_Level_Critical,
>             (  "Fault in On_Button_Click: "
>             &  Exception_Information (Error)
>          )  );
>    end On_Button_Click;
>
I tried different approaches but they cannot solve my problem. Part of 
the problem is probably that I am developing a package which should be 
usable in all different kind of programs maybe even under programs using 
all different kind of GUI's. That means that exception handling cannot 
always be done in the package but should be done in at least a package 
calling that problem. With this approach I tried to solve an earlier 
problem I asked about "Is there a way to see if a value is declared as a 
constant". I tried to solve that problem in a way that needed Exception 
handling during running to solve a design problem that could be made. I 
will need another way to go around that problem.

^ permalink raw reply	[relevance 0%]

* Re: Exception Handling within Gtkada
  2021-09-21  7:24  0%     ` Emmanuel Briot
@ 2021-09-21  7:40  0%       ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2021-09-21  7:40 UTC (permalink / raw)


On 2021-09-21 09:24, Emmanuel Briot wrote:
>>> Generally, Ada exceptions must not left scope of callback function. Thus, such code should be added to each callback/event handler/etc. subprogram of your application.
>> Right. Each handler should end like this:
> 
> We were talking the other day of the high-level Connect subprograms generated by GtkAda (`Gtk.Button.On_Clicked` and so on). Those will always catch exceptions and avoid propagating them to the C layer in gtk+ (which as Dmitry mentions is dangerous). They will in effect call `GtkAda.Bindings.Process_Exception`, which in turns calls a user-defined subprogram, see GtkAda.Bindings.Set_On_Exceptions

Very cool.

> I think this should be the recommended approach for general exceptions. Of course, your callbacks should directly handle exceptions that they know how to recover from, and deal with that locally.

Yes, but Ada does that much better. I mean rendezvous, which is Ada's 
idea of an event handling. An exception in a rendezvous propagates to 
the caller. For a GUI it would mean that if a callback fails the emitter 
of the signal gets an exception, which would be the right place to 
handle the issue rather than sweeping it under the rug.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 0%]

* Re: Exception Handling within Gtkada
  2021-09-21  7:01  0%   ` Dmitry A. Kazakov
@ 2021-09-21  7:24  0%     ` Emmanuel Briot
  2021-09-21  7:40  0%       ` Dmitry A. Kazakov
  2021-09-22  8:42  0%     ` ldries46
  1 sibling, 1 reply; 200+ results
From: Emmanuel Briot @ 2021-09-21  7:24 UTC (permalink / raw)


> > Generally, Ada exceptions must not left scope of callback function. Thus, such code should be added to each callback/event handler/etc. subprogram of your application.
> Right. Each handler should end like this: 

We were talking the other day of the high-level Connect subprograms generated by GtkAda (`Gtk.Button.On_Clicked` and so on). Those will always catch exceptions and avoid propagating them to the C layer in gtk+ (which as Dmitry mentions is dangerous). They will in effect call `GtkAda.Bindings.Process_Exception`, which in turns calls a user-defined subprogram, see GtkAda.Bindings.Set_On_Exceptions

I think this should be the recommended approach for general exceptions. Of course, your callbacks should directly handle exceptions that they know how to recover from, and deal with that locally.

^ permalink raw reply	[relevance 0%]

* Re: Exception Handling within Gtkada
  2021-09-21  6:49  5% ` Exception Handling within Gtkada Vadim Godunko
@ 2021-09-21  7:01  0%   ` Dmitry A. Kazakov
  2021-09-21  7:24  0%     ` Emmanuel Briot
  2021-09-22  8:42  0%     ` ldries46
  0 siblings, 2 replies; 200+ results
From: Dmitry A. Kazakov @ 2021-09-21  7:01 UTC (permalink / raw)


On 2021-09-21 08:49, Vadim Godunko wrote:
> On Monday, September 20, 2021 at 3:06:02 PM UTC+3, ldries46 wrote:
>> I want an exception to be seen within an existing window of Gtkada to be able to see details of the error. So I used:
>>
>> exception
>> when no_const =>
>> Main_Window.Buffer.Insert_At_Cursor
>> ("-------------------------------------------------------------------------"
>> & To_String(CRLF));
>> Main_Window.Buffer.Insert_At_Cursor("Error : io_const" & to_String(CRLF));
>> end Test_Exception;
>>
>> In this case the the program ends and the reason of the exception is lost. I want this only for a selected nr of exceptions. In this case the exception no_const.
> 
> Generally, Ada exceptions must not left scope of callback function. Thus, such code should be added to each callback/event handler/etc. subprogram of your application.

Right. Each handler should end like this:

    exception
       when Error : others =>
          Glib.Message.Log
          (  "My fancy program",
             Log_Level_Critical,
             (  "Fault in On_Button_Click: "
             &  Exception_Information (Error)
          )  );
    end On_Button_Click;

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 0%]

* Re: Exception Handling within Gtkada
       [not found]     <nnd$672ea4c3$361caa01@549d065034cf3e10>
@ 2021-09-21  6:49  5% ` Vadim Godunko
  2021-09-21  7:01  0%   ` Dmitry A. Kazakov
  0 siblings, 1 reply; 200+ results
From: Vadim Godunko @ 2021-09-21  6:49 UTC (permalink / raw)


On Monday, September 20, 2021 at 3:06:02 PM UTC+3, ldries46 wrote:
> I want an exception to be seen within an existing window of Gtkada to be able to see details of the error. So I used:
> 
> exception
> when no_const =>
> Main_Window.Buffer.Insert_At_Cursor
> ("-------------------------------------------------------------------------"
> & To_String(CRLF));
> Main_Window.Buffer.Insert_At_Cursor("Error : io_const" & to_String(CRLF));
> end Test_Exception;
> 
> In this case the the program ends and the reason of the exception is lost. I want this only for a selected nr of exceptions. In this case the exception no_const.

Generally, Ada exceptions must not left scope of callback function. Thus, such code should be added to each callback/event handler/etc. subprogram of your application.

^ permalink raw reply	[relevance 5%]

* Re: Alternative for Gnat Studio
  @ 2021-02-25 18:10  5%   ` Simon Wright
  0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2021-02-25 18:10 UTC (permalink / raw)


ldries46 <bertus.dries@planet.nl> writes:

> My problem has become more acute. Till now I avoided the debugging
> option in the GNAT 2020 Community edition by badding print statements 
> within the normal running program but now I have an error mentioned
> somewhere within the Ada. Unbounded_Strings which is used on a lot of 
> positions in the program. The only way I know to detect wher the
> problem is is using the debug option with several brakpoints and as
> possible shifting these around to find this error but uding the debu
> option just makes the program coming to the "program does not
> react".

If you can possibly bear it, you should try the command line. I don't
know what that would look like on Windows (unless you're using Cygwin?
which is Unix-y).

Sample program:

   pragma Assertion_Policy (Check);
   procedure Raiser is
      procedure Inner (N : Natural) is
         pragma Assert (N > 5);
      begin
         Inner (N - 1);
      end Inner;
   begin
      Inner (10);
   end Raiser;

Now, I'm sure you've built with a proper GPR, but to simplify the
example:

   gnatmake -g -O raiser.adb

Here, this produces the executable "raiser" in the current directory,
but if your GPR specifies the Object_Dir and not the Exec_Dir the
executable (in your case "raiser.exe") ends up in the Object_Dir, drat
it.

A very simple debugging session, assuming that the command "gdb" runs OK
might look like:

   $ gdb raiser
   GNU gdb (GDB) 7.10 for GNAT Community 2020 [rev=52ea9f0a422c99f69e7e6c44a04e654ceebc42e3]
   Copyright (C) 2015 Free Software Foundation, Inc.
   License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
   This is free software: you are free to change and redistribute it.
   See your support agreement for details of warranty and support.
   If you do not have a current support agreement, then there is absolutely
   no warranty for this version of GDB.  Type "show copying"
   and "show warranty" for details.
   This GDB was configured as "x86_64-apple-darwin17.7.0".
   Type "show configuration" for configuration details.For help, type "help".
   Type "apropos word" to search for commands related to "word"...
   Reading symbols from raiser...done.

Stop on any exception

   (gdb) catch exception
   Catchpoint 1: all Ada exceptions

Run to the start of the program

   (gdb) start
   Temporary breakpoint 2 at 0x100001f54: file raiser.adb, line 9.
   Starting program: /Users/simon/tmp/raiser 
   [New Thread 0x2303 of process 71543]
   
   Temporary breakpoint 2, raiser () at raiser.adb:9
   9	   Inner (10);

Carry on

   (gdb) continue
   Continuing.

Oops! (note, gdb knows to stop at the point in my code where the
exception was raised, rather than down in the details of the runtime
system calls)

   Catchpoint 1, SYSTEM.ASSERTIONS.ASSERT_FAILURE (raiser.adb:4) at 0x0000000100001f17 in raiser.inner (n=5) at raiser.adb:4
   4	      pragma Assert (N > 5);

Print a backtrace of how we got here

   (gdb) backtrace
   #0  <__gnat_debug_raise_exception> (
       e=0x1000142e0 <system.assertions.assert_failure>, message=...)
       at s-excdeb.adb:43
   #1  0x00000001000038ed in ada.exceptions.complete_occurrence (x=0x1004040c0)
       at a-except.adb:931
   #2  0x00000001000038fd in ada.exceptions.complete_and_propagate_occurrence (
       x=0x1004040c0) at a-except.adb:942
   #3  0x0000000100003952 in <__gnat_raise_exception> (
       e=0x1000142e0 <system.assertions.assert_failure>, message=...)
       at a-except.adb:984
   #4  0x0000000100004c13 in system.assertions.raise_assert_failure (msg=...)
       at s-assert.adb:46
   #5  0x0000000100001f17 in raiser.inner (n=5) at raiser.adb:4
   #6  0x0000000100001f3c in raiser.inner (n=6) at raiser.adb:6
   #7  0x0000000100001f3c in raiser.inner (n=7) at raiser.adb:6
   #8  0x0000000100001f3c in raiser.inner (n=8) at raiser.adb:6
   #9  0x0000000100001f3c in raiser.inner (n=9) at raiser.adb:6
   #10 0x0000000100001f3c in raiser.inner (n=10) at raiser.adb:6
   #11 0x0000000100001f65 in raiser () at raiser.adb:9

Look at the code at frame 8 (#8 in the backtrace)

   (gdb) frame 8
   #8  0x0000000100001f3c in raiser.inner (n=8) at raiser.adb:6
   6	      Inner (N - 1);

Print a variable

   (gdb) print n
   $1 = 8
   (gdb) 

^ permalink raw reply	[relevance 5%]

* Re: Lower bounds of Strings
  @ 2021-01-07  0:17  3%     ` Randy Brukardt
  0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2021-01-07  0:17 UTC (permalink / raw)


"Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> wrote in message 
news:rt3uv2$1nrd$1@gioia.aioe.org...
> On 2021-01-06 04:08, Randy Brukardt wrote:
>> IMHO, "String" shouldn't be an array at all. In a UTF-8 world, it makes
>> little sense to index into a string - it would be expensive to do it 
>> based
>> on characters (since they vary in size), and dangerous to do it based on
>> octets (since you could get part of a character).
>
> It will not work. There is no useful integral operations defined on 
> strings. It is like arguing that image is not an array of pixels because 
> you could distort objects in there when altering individual pixels.
>
>> The only real solution is to never use String in the first place. A 
>> number
>> of people are building UTF-8 abstractions to replace String, and I expect
>> those to become common in the coming years.
>
> This will never happen. Ada standard library already has lots of integral 
> operations defined on strings. They are practically never used. The UTF-8 
> (or whatever encoding) abstraction thing simply does not exist.
>
>> Indeed, (as I've mentioned before) I would go further and abandon arrays
>> altogether -- containers cover the same ground (or could easily) -- the 
>> vast
>> complication of operators popping up much after type declarations,
>> assignable slices, and supernull arrays all waste resources and cause
>> oddities and dangers. It's a waste of time to fix arrays in Ada -- just
>> don't use them.
>
> How these containers are supposed to be implemented?

Built-in to the implementation, of course. Implementing these things in Ada 
is a nice capability, because that allows simple quick-and-dirty 
implementations. But for things that are commonly used, that necessarily 
leads to lousy performance. One has to have at least some special cases even 
for the Ada.Containers to get adequate performance, so there's no problem 
extending that.

...
> How Stream_Element_Array is supposed to be an opaque container?

It should already be an opaque container. You use language-defined stream 
attributes to implement user-defined stream attributes - not unportable 
direct byte twiddling.

> How file read operation is supposed to assign part of a container?

??? Why would you want to do that? Streaming a bounded vector (which almost 
all existing arrays should be) naturally would read only the active part of 
the vector. Non-streaming reading is left over Ada 83 nonsense; all I/O 
should be built on top of streams (as a practical matter, the vast majority 
is anyway).

> You cannot rid of array interface with all its types involved: index, 
> index set (range), element, element set (array). A containers without the 
> array interface cannot replace array. Any language must support them. The 
> problem is that Ada has array interfaces once built-in and as an ugly lame 
> monstrosity of helper tagged types, a mockery of array.

There no reason that a container interface cannot have those things --  
Ada.Containers.Vectors does. The things that Vectors is missing (mainly the 
ability to use enumeration and modular indexes) was a mistake that I 
complained about repeatedly during the design, but I lost on that.

> Array implementation is a fundamental building block of computing.

Surely. But one does not need the nonsense of requiring an underlying 
implementation (which traditional arrays do) in order to get that building 
block. You always talk about this in terms of an "interface", which is 
essentially the same idea. One cannot have any sort of non-contigious or 
persistent arrays with the Ada interface, since operations like assigning 
into slices are impossible in such representations. One has to give those 
things up in order to have an "interface" rather than the concrete form for 
Ada arrays.

I prefer to not call the result an array, since an array implies a 
contiguous in-memory representation. Of course, some vectors will have such 
a representation, but that needs to be a requirement only for vectors used 
for interfacing. (And those should be used rarely.)

> That does not go either. Of course you could have two languages, one with 
> arrays to implement containers and one without them for end users. But 
> this is neither Ada philosophy nor a concept for any good 
> universal-purpose language.

Compilers implement arrays in Ada; there is no possibility a user doing it. 
I see no difference between that and having the compiler implement a bounded 
vector instead as the fundamental building block. You seem fixated on the 
form of declaration (that is a generic package vs. some sort of built-in 
syntax) -- there's no fundamental difference. There are many Ada packages 
that are built-in to compilers (for Janus/Ada, these include System and 
Ada.Exceptions and Ada.Assertions) -- there's no body or even source of 
these to be seen.

We're not even talking about different syntax for the use of vectors (and it 
would be easy to have some syntax sugar for declarations - we already have a 
proposal on those lines for Ada). Indeed, in a new language, one would 
certainly call these "array" containers (couldn't do that in Ada as the word 
"array" is reserved).

Sometimes, one has to step back and look at the bigger picture and not 
always at the way things have always been done. Arrays (at least as defined 
in Ada) have outlived their usefulness.

                          Randy.




^ permalink raw reply	[relevance 3%]

* Re: Visibility issue
  @ 2020-09-17 21:47  4% ` Shark8
  0 siblings, 0 replies; 200+ 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: Proposal: Auto-allocation of Indefinite Objects
  @ 2020-08-20 23:30  5%                           ` Randy Brukardt
  0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2020-08-20 23:30 UTC (permalink / raw)


"Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> wrote in message 
news:rhmd3m$1eql$2@gioia.aioe.org...
> On 20/08/2020 02:10, Randy Brukardt wrote:
>> "Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> wrote in message
>> news:rgr267$1o1n$1@gioia.aioe.org...
>>> No, from the abstraction point of view they do not. They indeed abstract
>>> the memory allocation aspect, but they do that at the cost of 
>>> *everything*
>>> else. Unbounded_String is no string anymore. Container is neither array
>>> nor record type. Unbounded_String must be converted forth and back. For
>>> containers I must use ugly hacks like iterators to make them resemble
>>> arrays and records introducing whole levels of complexity to fight 
>>> through
>>> every time the compiler or I miss something.
>>>
>>> In most cases I prefer to keep a clear array or record interface at the
>>> expense of manual memory management.
>>>
>>>> There's no free lunch.
>>>
>>> I think with a better type system there could be a whole banquet. (:-))
>>
>> Maybe. but IMHO a better type system would get rid of arrays and strings
>> altogether and only have containers/records of various sorts. The 
>> complexity
>> of having both solving the same problems (not very well in the case of
>> arrays/strings) doesn't buy much. I suspect that a user-defined "." as
>> you've proposed elsewhere would eliminate most of the rest of the 
>> problems
>> (and unify everything even further).
>
> But records and arrays are needed as building blocks of containers. How 
> would you get rid of them?

There's no reason that a compiler couldn't "build-in" a simple bounded 
vector container as the basic building block. We already do that for things 
like Ada.Exceptions, Unchecked_Conversion, and Unchecked_Deallocation, so 
it's no harder to do that for a vector. (Probably would need some sort of 
fixed vector for interfacing purposes as well, to deal with other language's 
and/or system's memory layout.)

One could do something similar for records, although I would probably leave 
them as in Ada and just allow user-definition of "." (via a getter/setter 
pair).

                                 Randy.


^ permalink raw reply	[relevance 5%]

* Re: GNAT vs Matlab - operation on   multidimensional complex matrices
  @ 2020-06-08 17:42  3% ` Shark8
  0 siblings, 0 replies; 200+ results
From: Shark8 @ 2020-06-08 17:42 UTC (permalink / raw)


Cleaning out my computer, I found this working-file; it might be of interesti to you -- it shows "going all-in" with Generics:
--------------------------------------------------------------
With
Ada.Real_Time,
Ada.Containers.Indefinite_Holders,
Ada.Numerics.Long_Complex_Types,
Ada.Exceptions,
Ada.Text_IO.Complex_IO;

Procedure Demo is
    package TIO renames Ada.Text_IO;
    package CTIO is new TIO.Complex_IO(Ada.Numerics.Long_Complex_Types);

    subtype mReal   is Long_Float;
    subtype Complex is Ada.Numerics.Long_Complex_Types.Complex;


    NumIteration : constant  := 1_000;
    NumChannels  : constant  := 64;
    NumRanges    : constant  := 400;
    NumAngles    : constant  := 30;


    Type Channel is range 1..NumChannels;
    Type Angle   is range 1..NumAngles;
    Type Range_T is range 1..NumRanges;

    type tCubeReal    is array (Channel, Angle, Range_T) of mReal;
    type tCubeComplex is array (Channel, Angle, Range_T) of Complex;

    Generic
        Type T is private;
        Type IndexA is (<>);
        Type IndexB is (<>);
        Type IndexC is (<>);
        Type Cubic is Array(IndexA, IndexB, indexC) of T;
        Zero : in T;
        with Function "+"(Left, Right: T) return T is <>;
    Function Summation( Input : Cubic ) return T
      with Inline;

    Function Summation( Input : Cubic ) return T is
    Begin
        Return Result : T := Zero do
            For A in IndexA loop
                For B in IndexB loop
                    For C in IndexC loop
                        Result:= Result + Input(A, B, C);
                    End loop;
                End loop;
            End loop;
        End return;
    End Summation;

    Generic
        Type Element is private;
        Type Cubic is array (Channel, Angle, Range_T) of Element;
        Zero : In Element;
        with Function "+"(Left, Right: Element) return Element is <>;
    Procedure Timing_Harness(Mtx : in Cubic;  S: out Element; Iterations : in Positive:= 1);

    Procedure Timing_Harness(Mtx : in Cubic;  S: out Element; Iterations : in Positive:= 1) is
        Function Sum is new Summation(Element, Channel, Angle, Range_T, Cubic, Zero);
        Use Ada.Real_Time;
        Start : Time renames Clock;
    Begin
        For Count in 1..Iterations Loop
            S := Sum( Mtx );
        End loop;


        METRICS:
        Declare
            Execution_Time  : Constant Time_Span:= Clock - Start;
            Execution_Image : Constant String:= Duration'Image(To_Duration(Execution_Time));
            T : Constant mReal := mReal(To_Duration(Execution_Time))/mReal(NumIteration);
        Begin
            TIO.New_Line;
            TIO.Put_Line("Computation time:" & Execution_Image );
            TIO.Put_Line("Computation time per iteration:" & mReal'Image(T));
        End METRICS;
    End Timing_Harness;


    Function Image( Input : mReal   )  return string renames mReal'Image;
    Function Image( Input : Complex )  return string is
        ('(' & mReal'Image(Input.Re) & ", " & mReal'Image(Input.Im) & ')');
    
    Generic
        Type T is private;
        Type IndexA is (<>);
        Type IndexB is (<>);
        Type IndexC is (<>);
        Type Cubic is Array(IndexA, IndexB, indexC) of T;
        Default : in T;
    Package Test_Data is
        Type Access_Cubic is not null access all Cubic;

        Access_Data : Constant Access_Cubic := new Cubic'(others => (others => (others => Default)));
        Data        : Cubic renames Access_Data.all;
    End Test_Data;

    Generic
        Type Element    is private;
        Type Cube_Array is array (Channel, Angle, Range_T) of Element;
        Default,
        Zero      : in Element;
        Test_Name : in String;
        with Function "+"(Left, Right: Element) return Element is <>;
        with Function Image( Input : Element )  return string  is <>;
    Procedure TEST;


    Procedure TEST is

        Package Test_Set is new Test_Data(
           T       => Element,
           IndexA  => Channel,
           IndexB  => Angle,
           IndexC  => Range_T,
           Cubic   => Cube_Array,
           Default => Default
          );
        
        procedure SpeedSum is new Timing_Harness(
           Element => Element,
           Cubic   => Cube_Array,
           Zero    => Zero,
           "+"     => TEST."+"
          );
        
        Cube   : Cube_Array renames Test_Set.Data;
        Result : Element;
    Begin
        TIO.Put_Line(Test_Name & " cube");
        TIO.Put_Line(Test_Name & " type size is:" & Integer'Image(Element'Size));

        SpeedSum(
           Mtx          => Cube,
           S            => Result,
           Iterations   => NumIteration
          );

        TIO.Put_Line("Sum is:" & Image(Result));
    End TEST;

Begin
    REAL_CUBE_TEST:
    Declare
        Procedure Do_Test is new Test(
           Element    => mReal,
           Cube_Array => tCubeReal,
           Default    => 1.0,
           Zero       => 0.0,
           Test_Name  => "Real"
          );
    Begin
        Do_Test;
    End REAL_CUBE_TEST;

    TIO.Put_Line( (1..20 => '-') ); -- Separator.

    COMPLEX_CUBE_TEST:
    Declare
        Procedure Do_Test is new Test(
           "+"        => Ada.Numerics.Long_Complex_Types."+",
           Element    => Complex,
           Cube_Array => tCubeComplex,
           Default    => (Re => 1.0, Im => 1.0),
           Zero       => (Re => 0.0, Im => 0.0),
           Test_Name  => "Complex"
          );
    Begin
        Do_Test;
    End COMPLEX_CUBE_TEST;



    TIO.Put_Line( (1..20 => '-') ); -- Separator.


    Ada.Text_IO.Put_Line( "Done." );
End Demo;

^ permalink raw reply	[relevance 3%]

* Re: CONSTRAINT ERROR: erroneous memory access
  2020-06-06 23:40  4% CONSTRAINT ERROR: erroneous memory access jcupak
@ 2020-06-07 15:53  0% ` Anh Vo
  0 siblings, 0 replies; 200+ results
From: Anh Vo @ 2020-06-07 15:53 UTC (permalink / raw)


On Saturday, June 6, 2020 at 4:40:04 PM UTC-7, jcu...@gmail.com wrote:
> It has been a few years since I have written Ada; I used and taught Ada 95 back when I was working for a defense contractor. But, now that I'm retired, I wanted to get up to speed with Ada 2012, so I decided to implement a main program to see how the Shortest_Paths generic package works (taken from A.18.31, pages 574-576). But, when I read in the data and call the Shortest_Path function, it returns with CONSTRAINT ERROR: erroneous memory access. I've tried multiple times, but can't seem to figure out what I'm doing (or NOT doing) wrong. 
> 
> Here's the main program:
> 
> with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
> with Ada.Float_Text_IO;   use Ada.Float_Text_IO;
> with Ada.Text_IO;         use Ada.Text_IO;
> with Shortest_Paths;
> with Ada.Command_Line;    use Ada.Command_Line;
> with DirectedEdge;        use DirectedEdge;
> with Ada.Containers;      use Ada.Containers;
> with Ada.Exceptions;
> 
> procedure Main_Test is
> 
>    Input_File : Ada.Text_IO.File_Type;
> 
>    Vertices   : Integer; -- Number of nodes
>    Edges      : Integer; -- Number of paths
> 
>    Tail       : Integer; -- Node From
>    Head       : Integer; -- Node To
>    Weight     : Float;   -- Path Weight/Distance/Cost
> 
>    -- Instantiate Shortest Paths package with 0..Integer'Last subtype
>    package SP is new Shortest_Paths(Node => Natural);
>    
>    -- Use Edge'Read to read the Edge components into Item
>    
>    -- Display directed edge components
>    procedure Display(Edge : in SP.Edge) is
>    begin
>       Put(Edge.From, Width=>1); Put("->");
>       Put(Edge.To,   Width=>1); Put(" ");
>       Put(Float(Edge.Length), Fore => 0, Aft => 2, Exp => 0); Put(" ");
>    end Display;
> 
>    -- Display directed edge components at cursor
>    -- Replace List'Write with Display
>    procedure Display(Cursor: in SP.Adjacency_Lists.Cursor)
>    is
>       Edge : SP.Edge := SP.Adjacency_Lists.Element(Cursor);
>    begin
>       Display(Edge); -- Let other procedure do all the work
>    end Display;
> 
> begin
> 
> -- Open input file using arg 1
>    Open (File => Input_File,
>          Mode => In_File,
>          Name => Argument(1)); -- ../tinyEWD.txt
> 
>    Set_Input(Input_File);        -- Redirect input
>    New_Line;
>    Put("Processing '"); Put(Argument(1)); Put_Line("'");
> 
>    -- Read number of nodes (vertices)
>    Get(Vertices); New_Line;
>    Put("Vertices: ");Put(Vertices, width=>2);New_Line;
> 
>    -- Read number of paths (edges)
>    Get(Edges);
>    Put("Edges:    ");Put(Edges, Width=>2);New_Line(2);
> 
>    declare
>    
>       -- Constrain Vertex to zero-based subrange
>       subtype Vertex is Natural range 0..Vertices-1;
>       
>       -- Adj is DLL of Adjacency Lists for each Vertex
>       Adj    : array (Vertex) of SP.Adjacency_Lists.List;
>       
>       -- Edge is a record of Tail, Head, and Weight components
>       Edge   : SP.Edge;
>    
>    begin
>    
>       Put_Line("Creating Adjacency Lists"); New_Line;
>    
>       -- For each node, create empty list of adjacent nodes
>       Create_Empty_Adjacency_Lists: for Node in Vertex loop
>       
>          -- Initialize each adjacency list to empty
>          Adj(Node) := SP.Adjacency_Lists.Empty_List;
>       
>       end loop Create_Empty_Adjacency_Lists;
>    
>       -- Display and append new edge to adjacency list for node
>       -- Constrain Edge index to natural subrange
>       Append_New_Edge: for E in 0..Edges-1 loop
>       
>          Put("Edge:     ");Put(E, Width=>2);Put(" ");
>       
>          -- Get edge components from data file
>          Get(Tail);   -- Tail
>          Get(Head);   -- Head
>          Get(Weight); -- Distance/Weight
>       
>          -- Set edge components
>          Edge.From   := Tail;
>          Edge.To     := Head;
>          Edge.Length := SP.Distance(Weight);
>       
>          -- Display Edge
>          Display(Edge);
>          Put(" Appended to edge ");Put(Tail,1);
>          New_Line;
>       
>          -- Append new edge to From adjacency list
>          -- Indicating path to another node
>          Adj(Edge.From).Append(Edge);
>       
>       end loop Append_New_Edge;
>       New_Line;
>    
>       Close(Input_File);
>       Set_Input(Standard_Input); -- Reset input source
>    
>       Put_Line("Node Adjacency Lists");
>    
>       -- Display contents of each adjacency list
>       Display_Adjacency_Lists: for Node in Vertex loop
>       
>          Put("Adj[");Put(Node, Width=>1);Put("] ");
>       
>          declare
>             Edges  : Ada.Containers.Count_Type;
>          begin
>          
>             -- How many edges are in this node?
>             Edges := SP.Adjacency_Lists.Length(Adj(Node));
>             Put(Integer(Edges), Width => 1);
>             if (Edges > 1) then
>                Put(" Edges: ");
>             else
>                Put(" Edge:  ");
>             end if;
>          
>             -- Iterate over all nodes in this adjacency list
>             -- and Display each edge for each node
>             SP.Adjacency_Lists.Iterate(Adj(Node), Process => Display'Access);
>          
>          end;
>          New_Line;
>       
>       end loop Display_Adjacency_Lists;
>       New_Line;
>    
>       -- Create Edge-Weighted Graph of Node and Adjacency List
>       declare
>          EWG    : SP.Graphs.Vector; -- Edge Weighted Graphs
>          Path   : SP.Paths.List;    -- Shortest Path
>       begin
>       
>          Put_Line("Creating Edge-Weighted Graphs.");
>          EWG := SP.Graphs.Empty_Vector;
>          Put_Line("EWG Empty_Vector created.");
>          
>          Put("Initializing Shortest Path to empty list...");
>          Path := SP.Paths.Empty_List;
>          Put_Line("done.");
>          
>          for Vertex in 0..Vertices-1 loop
>             Put("Vertex: ");Put(Vertex, Width => 1);
>             EWG.Append(Adj(Vertex));
>             Put_Line(" appended to EWG.");
>          end loop;
>          New_Line;
>          
>          Put("EWG.Length = "); Put(Integer(EWG.Length), Width => 1);New_Line;
>       
>          Put_Line("Finding shortest path from node 0 to node 6");
>          declare
>             use Ada.Exceptions;
>          begin
>             -- Compute Shortest Path
>             Path := SP.Shortest_Path
>                (EWG, Source => 0, Target => 6);
>             exception
>                when Error: others =>
>                   New_Line;
>                   Put_Line(Exception_Name(Error));
>                   Put_Line(Exception_Message(Error));
>                   New_Line;
>                   Return;
>          end;
>       
>          Put("The Shortest Path from Node 0 to Node 6 ");
>          Put("contains "); Put(Integer(Path.Length)); Put(" entries.");
>          -- Display path
>       end;
>    
>    
>    end;
> 
> end Main_Test;
> 
> And here's the test data (taken from Algorithms, by Sedwick):
> 
> 8
> 15
> 4 5 0.35
> 5 4 0.35
> 4 7 0.37
> 5 7 0.28
> 7 5 0.28
> 5 1 0.32
> 0 4 0.38
> 0 2 0.26
> 7 3 0.39
> 1 3 0.29
> 2 7 0.34
> 6 2 0.40
> 3 6 0.52
> 6 0 0.58
> 6 4 0.93

It is hard to comment without Ada units Shortest_Path and DirectedEdge posted. In other word, your code does not compile.

Anh Vo 

^ permalink raw reply	[relevance 0%]

* CONSTRAINT ERROR: erroneous memory access
@ 2020-06-06 23:40  4% jcupak
  2020-06-07 15:53  0% ` Anh Vo
  0 siblings, 1 reply; 200+ results
From: jcupak @ 2020-06-06 23:40 UTC (permalink / raw)


It has been a few years since I have written Ada; I used and taught Ada 95 back when I was working for a defense contractor. But, now that I'm retired, I wanted to get up to speed with Ada 2012, so I decided to implement a main program to see how the Shortest_Paths generic package works (taken from A.18.31, pages 574-576). But, when I read in the data and call the Shortest_Path function, it returns with CONSTRAINT ERROR: erroneous memory access. I've tried multiple times, but can't seem to figure out what I'm doing (or NOT doing) wrong. 

Here's the main program:

with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Float_Text_IO;   use Ada.Float_Text_IO;
with Ada.Text_IO;         use Ada.Text_IO;
with Shortest_Paths;
with Ada.Command_Line;    use Ada.Command_Line;
with DirectedEdge;        use DirectedEdge;
with Ada.Containers;      use Ada.Containers;
with Ada.Exceptions;

procedure Main_Test is

   Input_File : Ada.Text_IO.File_Type;

   Vertices   : Integer; -- Number of nodes
   Edges      : Integer; -- Number of paths

   Tail       : Integer; -- Node From
   Head       : Integer; -- Node To
   Weight     : Float;   -- Path Weight/Distance/Cost

   -- Instantiate Shortest Paths package with 0..Integer'Last subtype
   package SP is new Shortest_Paths(Node => Natural);
   
   -- Use Edge'Read to read the Edge components into Item
   
   -- Display directed edge components
   procedure Display(Edge : in SP.Edge) is
   begin
      Put(Edge.From, Width=>1); Put("->");
      Put(Edge.To,   Width=>1); Put(" ");
      Put(Float(Edge.Length), Fore => 0, Aft => 2, Exp => 0); Put(" ");
   end Display;

   -- Display directed edge components at cursor
   -- Replace List'Write with Display
   procedure Display(Cursor: in SP.Adjacency_Lists.Cursor)
   is
      Edge : SP.Edge := SP.Adjacency_Lists.Element(Cursor);
   begin
      Display(Edge); -- Let other procedure do all the work
   end Display;

begin

-- Open input file using arg 1
   Open (File => Input_File,
         Mode => In_File,
         Name => Argument(1)); -- ../tinyEWD.txt

   Set_Input(Input_File);        -- Redirect input
   New_Line;
   Put("Processing '"); Put(Argument(1)); Put_Line("'");

   -- Read number of nodes (vertices)
   Get(Vertices); New_Line;
   Put("Vertices: ");Put(Vertices, width=>2);New_Line;

   -- Read number of paths (edges)
   Get(Edges);
   Put("Edges:    ");Put(Edges, Width=>2);New_Line(2);

   declare
   
      -- Constrain Vertex to zero-based subrange
      subtype Vertex is Natural range 0..Vertices-1;
      
      -- Adj is DLL of Adjacency Lists for each Vertex
      Adj    : array (Vertex) of SP.Adjacency_Lists.List;
      
      -- Edge is a record of Tail, Head, and Weight components
      Edge   : SP.Edge;
   
   begin
   
      Put_Line("Creating Adjacency Lists"); New_Line;
   
      -- For each node, create empty list of adjacent nodes
      Create_Empty_Adjacency_Lists: for Node in Vertex loop
      
         -- Initialize each adjacency list to empty
         Adj(Node) := SP.Adjacency_Lists.Empty_List;
      
      end loop Create_Empty_Adjacency_Lists;
   
      -- Display and append new edge to adjacency list for node
      -- Constrain Edge index to natural subrange
      Append_New_Edge: for E in 0..Edges-1 loop
      
         Put("Edge:     ");Put(E, Width=>2);Put(" ");
      
         -- Get edge components from data file
         Get(Tail);   -- Tail
         Get(Head);   -- Head
         Get(Weight); -- Distance/Weight
      
         -- Set edge components
         Edge.From   := Tail;
         Edge.To     := Head;
         Edge.Length := SP.Distance(Weight);
      
         -- Display Edge
         Display(Edge);
         Put(" Appended to edge ");Put(Tail,1);
         New_Line;
      
         -- Append new edge to From adjacency list
         -- Indicating path to another node
         Adj(Edge.From).Append(Edge);
      
      end loop Append_New_Edge;
      New_Line;
   
      Close(Input_File);
      Set_Input(Standard_Input); -- Reset input source
   
      Put_Line("Node Adjacency Lists");
   
      -- Display contents of each adjacency list
      Display_Adjacency_Lists: for Node in Vertex loop
      
         Put("Adj[");Put(Node, Width=>1);Put("] ");
      
         declare
            Edges  : Ada.Containers.Count_Type;
         begin
         
            -- How many edges are in this node?
            Edges := SP.Adjacency_Lists.Length(Adj(Node));
            Put(Integer(Edges), Width => 1);
            if (Edges > 1) then
               Put(" Edges: ");
            else
               Put(" Edge:  ");
            end if;
         
            -- Iterate over all nodes in this adjacency list
            -- and Display each edge for each node
            SP.Adjacency_Lists.Iterate(Adj(Node), Process => Display'Access);
         
         end;
         New_Line;
      
      end loop Display_Adjacency_Lists;
      New_Line;
   
      -- Create Edge-Weighted Graph of Node and Adjacency List
      declare
         EWG    : SP.Graphs.Vector; -- Edge Weighted Graphs
         Path   : SP.Paths.List;    -- Shortest Path
      begin
      
         Put_Line("Creating Edge-Weighted Graphs.");
         EWG := SP.Graphs.Empty_Vector;
         Put_Line("EWG Empty_Vector created.");
         
         Put("Initializing Shortest Path to empty list...");
         Path := SP.Paths.Empty_List;
         Put_Line("done.");
         
         for Vertex in 0..Vertices-1 loop
            Put("Vertex: ");Put(Vertex, Width => 1);
            EWG.Append(Adj(Vertex));
            Put_Line(" appended to EWG.");
         end loop;
         New_Line;
         
         Put("EWG.Length = "); Put(Integer(EWG.Length), Width => 1);New_Line;
      
         Put_Line("Finding shortest path from node 0 to node 6");
         declare
            use Ada.Exceptions;
         begin
            -- Compute Shortest Path
            Path := SP.Shortest_Path
               (EWG, Source => 0, Target => 6);
            exception
               when Error: others =>
                  New_Line;
                  Put_Line(Exception_Name(Error));
                  Put_Line(Exception_Message(Error));
                  New_Line;
                  Return;
         end;
      
         Put("The Shortest Path from Node 0 to Node 6 ");
         Put("contains "); Put(Integer(Path.Length)); Put(" entries.");
         -- Display path
      end;
   
   
   end;

end Main_Test;

And here's the test data (taken from Algorithms, by Sedwick):

8
15
4 5 0.35
5 4 0.35
4 7 0.37
5 7 0.28
7 5 0.28
5 1 0.32
0 4 0.38
0 2 0.26
7 3 0.39
1 3 0.29
2 7 0.34
6 2 0.40
3 6 0.52
6 0 0.58
6 4 0.93

^ permalink raw reply	[relevance 4%]

* Re: Getting the 3 letter time zone abbreviation
  @ 2020-04-30 21:11  5%         ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2020-04-30 21:11 UTC (permalink / raw)


On 2020-04-30 20:59, Bob Goddard wrote:
> On Wednesday, 29 April 2020 20:53:11 UTC+1, Dmitry A. Kazakov  wrote:
>> On 2020-04-29 21:20, Bob Goddard wrote:
>>
>>> Seems easier just to import strftime and call it requesting just "%Z". This is on Linux, but MS suggests it should also work on Windows.
>>
>> An interesting idea. Did you try it under Windows? (There is a
>> suspicious remark that it depends on the setlocale)
> 
> 'Fraid not, I'm a Linux user. I just noticed that Windows does have it.

OK, I tested it. As expected it does not work. For example this one:
---------------------------
with Ada.Command_Line;           use Ada.Command_Line;
with Interfaces.C;               use Interfaces.C;
with Ada.Exceptions;             use Ada.Exceptions;
with Ada.Text_IO;                use Ada.Text_IO;

with System;

procedure Strftime_Test is

    type tm is record
       tm_sec   : int;
       tm_min   : int;
       tm_hour  : int;
       tm_mday  : int;
       tm_mon   : int;
       tm_year  : int;
       tm_wday  : int;
       tm_yday  : int;
       tm_isdst : int;
    end record;
    pragma Convention (C, tm);
    type tm_Ptr is access all tm;
    pragma Convention (C, tm_Ptr);

    type time_t is new Interfaces.Unsigned_64;

    function localtime (timep : access time_t) return tm_Ptr;
    pragma Import (C, localtime);

    function time (destTime : System.Address := System.Null_Address)
       return time_t;
    pragma Import (C, time, "_time64");

    function strftime
             (  strDest : char_array;
                maxsize : size_t;
                format  : char_array;
                timeptr : access tm
             )  return size_t;
    pragma Import (C, strftime);

    Result    : size_t;
    Buffer    : char_array (1..200);
    Now       : aliased time_t := 0;
    Local_Ptr : tm_Ptr;
begin
    Now := time;
    Put_Line ("Time=" & time_t'Image (Now));
    Local_Ptr := localtime (Now'Access);
    if Local_Ptr /= null then
       declare
          Local : tm renames localtime (Now'Access).all;
       begin
          Put_Line
          (  int'Image (Local.tm_year)
          &  " -"
          &  int'Image (Local.tm_mon)
          &  " -"
          &  int'Image (Local.tm_mday)
          &  " "
          &  int'Image (Local.tm_hour)
          &  " :"
          &  int'Image (Local.tm_min)
          &  " :"
          &  int'Image (Local.tm_sec)
          );
          Result := strftime
                    (  Buffer,
                       Buffer'Length,
                       To_C ("%#Z"),
                       Local'Access
                    );
          Put_Line ("Result=" & To_Ada (Buffer (1..Result), False));
       end;
    end if;
    Set_Exit_Status (0);
exception
    when Error : Status_Error | Data_Error =>
       Put_Line (Exception_Message (Error));
       Set_Exit_Status (1);
    when Error : others =>
       Put_Line ("Fault: " & Exception_Information (Error));
       Set_Exit_Status (2);
end Strftime_Test;
----------------------------------

Gives the output on my Windows machine:

    Result=W. Europe Daylight Time

instead of

    CEST

Windows POSIX layer relies on Windows API. If the API does something 
wrong, so would whatever POSIX function.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 5%]

* Re: Simple parse from https website
  2020-04-02 17:16  4%     ` Dmitry A. Kazakov
@ 2020-04-02 18:27  0%       ` Rego, P.
  0 siblings, 0 replies; 200+ results
From: Rego, P. @ 2020-04-02 18:27 UTC (permalink / raw)


> No, that site looks OK. I modified my OpenSSL HTTP client. I just added 
> JSON parser and procedure Dump to print the JSON object:
> 
> ----------------------------- test_https_openssl_json_client.adb -----
> with Ada.Exceptions;               use Ada.Exceptions;
> with Ada.Text_IO;                  use Ada.Text_IO;
> with Ada.Streams;                  use Ada.Streams;
> --with GNAT.Exception_Traces;      use GNAT.Exception_Traces;
> with GNAT.Sockets.Server.Handles;  use GNAT.Sockets.Server.Handles;
> with GNAT.Sockets.Server.OpenSSL;  use GNAT.Sockets.Server.OpenSSL;
> with OpenSSL;                      use OpenSSL;
> with Parsers.JSON;                 use Parsers.JSON;
> with Parsers.JSON.String_Source;   use Parsers.JSON.String_Source;
> with Strings_Edit.Integers;        use Strings_Edit.Integers;
> with Strings_Edit.Quoted;          use Strings_Edit.Quoted;
> with Strings_Edit.Streams;         use Strings_Edit.Streams;
> with Strings_Edit.Long_Floats;     use Strings_Edit.Long_Floats;
> with Test_HTTP_Servers.OpenSSL;    use Test_HTTP_Servers.OpenSSL;
> 
> with GNAT.Sockets.Connection_State_Machine.HTTP_Client.Signaled;
> with GNAT.Sockets.Server.Pooled;
> with Parsers.String_Source;
> with Stack_Storage;
> 
> procedure Test_HTTPS_OpenSSL_JSON_Client is
>     use GNAT.Sockets.Connection_State_Machine.HTTP_Client.Signaled;
> 
>     Address : constant String := "poloniex.com";
>     Path    : constant String := "public?command=returnTicker";
>     Port    : constant := 443;
> 
>     procedure Dump (Prefix : String; Value : JSON_Value) is
>     begin
>        case Value.JSON_Type is
>           when JSON_Boolean =>
>              Put_Line (Prefix & Boolean'Image (Value.Condition));
>           when JSON_Null =>
>              Put_Line (Prefix & "null");
>           when JSON_Number =>
>              Put_Line (Prefix & Image (Value.Value));
>           when JSON_String =>
>              Put_Line (Prefix & Quote (Value.Text.all));
>           when JSON_Array =>
>              Put_Line (Prefix & "(");
>              for Index in Value.Sequence'Range loop
>                 Dump (Prefix & "   ", Value.Sequence (Index));
>              end loop;
>              Put_Line (Prefix & ")");
>           when JSON_Object =>
>              Put_Line (Prefix & "{");
>              for Index in Value.Map'Range loop
>                 Put_Line (Prefix & "   " & Value.Map (Index).Name.all & 
> "=");
>                 Dump (Prefix & "      ", Value.Map (Index).Value);
>              end loop;
>              Put_Line (Prefix & "}");
>        end case;
>     end Dump;
> begin
>     declare
>        Factory : aliased HTTPS_OpenSSL_Factory
>                          (  Request_Length  => 200,
>                             Input_Size      => 40,
>                             Output_Size     => 1024,
>                             Decoded_Size    => 40,
>                             Max_Connections => 100
>                          );
>     begin
>        Set_Default_Verify_Paths (Factory, Client_Context);
>        declare
>           Message   : aliased String_Stream (1024 * 100);
>           Server    : aliased GNAT.Sockets.Server.
>                               Connections_Server (Factory'Access, 0);
>           Reference : GNAT.Sockets.Server.Handles.Handle;
>        begin
>           Put_Line ("HTTP client started");
>           Set
>           (  Reference,
>              new HTTP_Session_Signaled
>                  (  Server'Unchecked_Access,
>                     200,
>                     512,
>                     1024
>           )      );
>           declare
>              Client : HTTP_Session_Signaled renames
>                       HTTP_Session_Signaled (Ptr (Reference).all);
>           begin
>              Connect (Client, Address, Port);
>              Get
>              (  Client,
>                 "https://" & Address & "/" & Path,
>                 Message'Unchecked_Access
>              );
>              Wait (Client, False);
>              Put_Line
>              (  Image (Get_Response_Code (Client))
>              &  " "
>              &  Get_Response_Reason (Client)
>              &  " Message >>>>>>>>>>>>>>>>>>>>"
>              );
>              declare
>                 Content : aliased String := Get (Message);
>                 Source  : aliased Parsers.String_Source.
>                                   Source (Content'Access);
>                 Arena   : aliased Stack_Storage.Pool (1024, 10);
>                 Data    : constant JSON_Value :=
>                                    Parse (Source'Access, Arena'Access);
>              begin
>                 Dump ("", Data);
>              end;
>              Put_Line ("<<<<<<<<<<<<<<<<<<<< Message");
>           end;
>           Put_Line ("HTTP client stopping");
>        end;
>     end;
> exception
>     when Error : others =>
>        Put_Line ("Error: " & Exception_Information (Error));
> end Test_HTTPS_OpenSSL_JSON_Client;
> ----------------------------- test_https_openssl_json_client.adb -----
> 
> It connects fine and spills lots of garbage like:
> 
>    ...
>     USDT_SNX=
>        {
>           id=
>              290.9999999999999
>           last=
>              "0.00000000"
>           lowestAsk=
>              "0.00000000"
>           highestBid=
>              "0.00000000"
>           percentChange=
>              "0.00000000"
>           baseVolume=
>              "0.00000000"
>           quoteVolume=
>              "0.00000000"
>           isFrozen=
>              "0"
>           high24hr=
>              "0.00000000"
>           low24hr=
>              "0.00000000"
>        }
>     TRX_SNX=
>        {
>           id=
>              292.0000000000000
>           last=
>              "0.00000000"
>           lowestAsk=
>              "0.00000000"
>           highestBid=
>              "0.00000000"
>           percentChange=
>              "0.00000000"
>      ...
> 
> and so on. Funny enough, they put numbers as strings, so it seems.
> 
> It is not very efficient as written. You see, the code it accumulates 
> all response in a string stream buffer. Then takes a string from that. 
> Then it parses the obtained string into a JSON object. So it is two 
> copies too many. One could parse the response on the fly without 
> accumulating it whole in the memory. But it would mean more efforts.

Omg... (almost) Perfect(!lol)...just discovered that GNAT.Sockets has a signature change, some subpackages are no more exposed (like GNAT.SOCKETS.Server). I am using GNAT Community 2019.

Builder results
        17:6 file "g-scstma.ads" not found
        6:6 file "g-socser.ads" not found
        7:6 file "g-socser.ads" not found
        18:6 file "g-socser.ads" not found
        8:6 file "openssl.ads" not found
        9:6 file "parsers.ads" not found
        10:6 file "parsers.ads" not found
        19:6 file "parsers.ads" not found
        20:6 file "stack_storage.ads" not found
        11:6 file "strings_edit.ads" not found
        12:6 file "strings_edit.ads" not found
        13:6 file "strings_edit.ads" not found
        14:6 file "strings_edit.ads" not found
        15:6 file "test_http_servers.ads" not found


^ permalink raw reply	[relevance 0%]

* Re: Simple parse from https website
  @ 2020-04-02 17:16  4%     ` Dmitry A. Kazakov
  2020-04-02 18:27  0%       ` Rego, P.
  0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2020-04-02 17:16 UTC (permalink / raw)


On 2020-04-02 16:48, Rego, P. wrote:

> Ops...not, just testing more simpler cases. I am trying to get the data from
> https://poloniex.com/public?command=returnTicker
> 
> Just tried with google to check if it's problem from polo ticker. But the exception was the same.

No, that site looks OK. I modified my OpenSSL HTTP client. I just added 
JSON parser and procedure Dump to print the JSON object:

----------------------------- test_https_openssl_json_client.adb -----
with Ada.Exceptions;               use Ada.Exceptions;
with Ada.Text_IO;                  use Ada.Text_IO;
with Ada.Streams;                  use Ada.Streams;
--with GNAT.Exception_Traces;      use GNAT.Exception_Traces;
with GNAT.Sockets.Server.Handles;  use GNAT.Sockets.Server.Handles;
with GNAT.Sockets.Server.OpenSSL;  use GNAT.Sockets.Server.OpenSSL;
with OpenSSL;                      use OpenSSL;
with Parsers.JSON;                 use Parsers.JSON;
with Parsers.JSON.String_Source;   use Parsers.JSON.String_Source;
with Strings_Edit.Integers;        use Strings_Edit.Integers;
with Strings_Edit.Quoted;          use Strings_Edit.Quoted;
with Strings_Edit.Streams;         use Strings_Edit.Streams;
with Strings_Edit.Long_Floats;     use Strings_Edit.Long_Floats;
with Test_HTTP_Servers.OpenSSL;    use Test_HTTP_Servers.OpenSSL;

with GNAT.Sockets.Connection_State_Machine.HTTP_Client.Signaled;
with GNAT.Sockets.Server.Pooled;
with Parsers.String_Source;
with Stack_Storage;

procedure Test_HTTPS_OpenSSL_JSON_Client is
    use GNAT.Sockets.Connection_State_Machine.HTTP_Client.Signaled;

    Address : constant String := "poloniex.com";
    Path    : constant String := "public?command=returnTicker";
    Port    : constant := 443;

    procedure Dump (Prefix : String; Value : JSON_Value) is
    begin
       case Value.JSON_Type is
          when JSON_Boolean =>
             Put_Line (Prefix & Boolean'Image (Value.Condition));
          when JSON_Null =>
             Put_Line (Prefix & "null");
          when JSON_Number =>
             Put_Line (Prefix & Image (Value.Value));
          when JSON_String =>
             Put_Line (Prefix & Quote (Value.Text.all));
          when JSON_Array =>
             Put_Line (Prefix & "(");
             for Index in Value.Sequence'Range loop
                Dump (Prefix & "   ", Value.Sequence (Index));
             end loop;
             Put_Line (Prefix & ")");
          when JSON_Object =>
             Put_Line (Prefix & "{");
             for Index in Value.Map'Range loop
                Put_Line (Prefix & "   " & Value.Map (Index).Name.all & 
"=");
                Dump (Prefix & "      ", Value.Map (Index).Value);
             end loop;
             Put_Line (Prefix & "}");
       end case;
    end Dump;
begin
    declare
       Factory : aliased HTTPS_OpenSSL_Factory
                         (  Request_Length  => 200,
                            Input_Size      => 40,
                            Output_Size     => 1024,
                            Decoded_Size    => 40,
                            Max_Connections => 100
                         );
    begin
       Set_Default_Verify_Paths (Factory, Client_Context);
       declare
          Message   : aliased String_Stream (1024 * 100);
          Server    : aliased GNAT.Sockets.Server.
                              Connections_Server (Factory'Access, 0);
          Reference : GNAT.Sockets.Server.Handles.Handle;
       begin
          Put_Line ("HTTP client started");
          Set
          (  Reference,
             new HTTP_Session_Signaled
                 (  Server'Unchecked_Access,
                    200,
                    512,
                    1024
          )      );
          declare
             Client : HTTP_Session_Signaled renames
                      HTTP_Session_Signaled (Ptr (Reference).all);
          begin
             Connect (Client, Address, Port);
             Get
             (  Client,
                "https://" & Address & "/" & Path,
                Message'Unchecked_Access
             );
             Wait (Client, False);
             Put_Line
             (  Image (Get_Response_Code (Client))
             &  " "
             &  Get_Response_Reason (Client)
             &  " Message >>>>>>>>>>>>>>>>>>>>"
             );
             declare
                Content : aliased String := Get (Message);
                Source  : aliased Parsers.String_Source.
                                  Source (Content'Access);
                Arena   : aliased Stack_Storage.Pool (1024, 10);
                Data    : constant JSON_Value :=
                                   Parse (Source'Access, Arena'Access);
             begin
                Dump ("", Data);
             end;
             Put_Line ("<<<<<<<<<<<<<<<<<<<< Message");
          end;
          Put_Line ("HTTP client stopping");
       end;
    end;
exception
    when Error : others =>
       Put_Line ("Error: " & Exception_Information (Error));
end Test_HTTPS_OpenSSL_JSON_Client;
----------------------------- test_https_openssl_json_client.adb -----

It connects fine and spills lots of garbage like:

   ...
    USDT_SNX=
       {
          id=
             290.9999999999999
          last=
             "0.00000000"
          lowestAsk=
             "0.00000000"
          highestBid=
             "0.00000000"
          percentChange=
             "0.00000000"
          baseVolume=
             "0.00000000"
          quoteVolume=
             "0.00000000"
          isFrozen=
             "0"
          high24hr=
             "0.00000000"
          low24hr=
             "0.00000000"
       }
    TRX_SNX=
       {
          id=
             292.0000000000000
          last=
             "0.00000000"
          lowestAsk=
             "0.00000000"
          highestBid=
             "0.00000000"
          percentChange=
             "0.00000000"
     ...

and so on. Funny enough, they put numbers as strings, so it seems.

It is not very efficient as written. You see, the code it accumulates 
all response in a string stream buffer. Then takes a string from that. 
Then it parses the obtained string into a JSON object. So it is two 
copies too many. One could parse the response on the fly without 
accumulating it whole in the memory. But it would mean more efforts.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 4%]

* Re: Last chance handler on a PC
  @ 2020-01-30 19:35  6% ` ahlan
  0 siblings, 0 replies; 200+ results
From: ahlan @ 2020-01-30 19:35 UTC (permalink / raw)


On Thursday, January 30, 2020 at 9:55:42 AM UTC+1, ah...@marriott.org wrote:
> Hi,
> 
> Does anyone know if it is possible to install a last chance handler for a PC program.
> Ie Write a procedure that gets called when a program issues an unhandled exception
> If it is possible how do you do it?

To answer my own question...
To catch unhandled exceptions you only need to write a simple procedure and export it as __gnat_last_chance_handler.
This is linked into the program in preference to the default last chance handler provided by GNAT.
This procedure is called if nothing catches a raised exception.
Including those raised during package elaboration.

The procedure is not allowed to return so after doing whatever it is you want to do with the exception you must call __gant_unhandled_terminate

The following is an example.

procedure Last_Chance_Handler (Occurrence : Ada.Exceptions.Exception_Occurrence)
  with
    No_Return, Unreferenced, Export,
    Convention    => C,
    External_Name => "__gnat_last_chance_handler";

  procedure Last_Chance_Handler (Occurrence : Ada.Exceptions.Exception_Occurrence) is

    procedure Unhandled_Terminate
    with
      No_Return, Import,
      Convention    => C,
      External_Name => "__gnat_unhandled_terminate";

  begin
    begin
      null;  -- Process the exception here.
    exception
    when others =>
      null;
    end;
    Unhandled_Terminate;
  end Last_Chance_Handler;

^ permalink raw reply	[relevance 6%]

* hello world ada-ncurses new_window
@ 2019-11-07 22:05  6% Alain De Vos
  0 siblings, 0 replies; 200+ results
From: Alain De Vos @ 2019-11-07 22:05 UTC (permalink / raw)


Creating a window in ada-ncurses raises an exception :

Code,

with Terminal_Interface.Curses; 
use  Terminal_Interface.Curses;
....
with Ada.Exceptions; 
use  Ada.Exceptions;
with GNAT.OS_Lib;
use GNAT.OS_Lib;
with Text_IO;
use Text_IO;
with Ada.Text_IO;
use Ada.Text_IO;

procedure test01 is
begin
   W1 := New_Window (5,5,1,1);
   Delete (W1);
exception
      when Event : others =>
         Terminal_Interface.Curses.End_Windows;
         Text_IO.Put ("Exception: ");
         Text_IO.Put (Exception_Name (Event));
         Text_IO.New_Line;
         GNAT.OS_Lib.OS_Exit (1);
end test01;

Exception:
raised TERMINAL_INTERFACE.CURSES.CURSES_EXCEPTION : terminal_interface-curses.adb:117

^ permalink raw reply	[relevance 6%]

* Re: gtkada evenhandler on_procedure method , how to access children of topwindow in the eventhandler
  @ 2019-11-02 19:21  6%   ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2019-11-02 19:21 UTC (permalink / raw)


On 2019-11-02 20:07, Alain De Vos wrote:
> On Saturday, November 2, 2019 at 11:22:49 AM UTC+1, Alain De Vos wrote:
>> I have a window with obe button and one label and want to change the text on the label when the button is pressed in the eventhandler, I pass the top window.
>>
>> procedure hello is
>>     Top     : Gtk.Window.Gtk_Window;
>>     Button  : Gtk_Button;
>>     Label   : Gtk_Label;
>>     VBox    : Gtk_Box;
>>     procedure Create_Window is
>>     begin
>>        Gtk.Window.Gtk_New
>>          (Window   => Top,
>>           The_Type => Gtk.Enums.Window_Toplevel);
>>        Gtk.Window.Set_Title (Window => Top, Title  => "Hello from ADA");
>>        Gtk_New(Button);
>>        Button.On_Clicked (Call => On_Button_Click'Access,
>>                           Slot => Top);
>>        Gtk_New(Label);
>>        Gtk_New_Vbox(VBox);
>>        Add (VBox,Button);
>>        Add (VBox,Label);
>>        Add (Top,VBox);
>>        Gtk.Window.Show_All (Top);
>>     end Create_Window;
>> begin
>>     Gtk.Main.Init;
>>     Create_Window;
>>     Gtk.Main.Main;
>> end hello;
>>
>> I pass the topwindow to the eventhandler(slot).
>> In the eventhandler I need go from the Top to the Vbox to the Label and set the text on the label ... button pressed. I probably need to set a property in the main and query it in the handler and cast the correct type ...
>> {The label is not directly visible in the handler ...}
>>
>> package body buttonhandler is
>>     procedure On_Button_Click (Top : access Glib.Object.GObject_Record'Class) is
>>     begin
>>        Put_line ("Hallo");
>>        -- I need to go from Top to Vbox to Label and set text ... ????
>>     end On_Button_Click;
>> end buttonhandler;
> 
> Ok, so now I try to force a casting, but I'm still not there,
> 
> package body buttonhandler is
>     type MyVBoxR is new Gtk_VBox_Record with record
>        Button : Gtk_Button;
>        Label  : Gtk_Label;
>     end record;
>     type MyVBoxT is access all MyVBoxR'Class;
>     procedure On_Button_Click (T : access Glib.Object.GObject_Record'Class) is
>        MyVBox  : MyVBoxT;
>     begin
>        Put_line ("You pressed");
>        MyVBox :=MyVBoxT (T);   -- Dangerous
>        Gtk.Button.Set_Label (MyVBox.Button,"You pressed");
>     end On_Button_Click;
> end buttonhandler;
> 
> No compile time warning but a runtime error on "MyVBox :=MyVBoxT (T);"  ,
> the error is :
> Hallo
> raised CONSTRAINT_ERROR : buttonhandler.adb:15 tag check failed

Which is why the idea is bad.

The proper conversion would look like this:

    MyVBoxR'Class (T.all)'Unchecked_Access

However in Ada it is done rather this way:

    procedure On_Button_Click (T : access GObject_Record'Class) is
       MyVBox : MyVBoxR'Class renames MyVBoxR'Class (T.all);
    begin
       MyVBox.Button.Set_Label ("You pressed");
       ...

Note that in GtkAda you must catch and suppress exceptions. If Ada 
exceptions propagate into C code they kill all application. The right 
way is this:

    with GLib.Messages;  use GLib.Messages;

    procedure On_Button_Click (T : access GObject_Record'Class) is
    begin
       declare
          MyVBox : MyVBoxR'Class renames MyVBoxR'Class (T.all);
       begin
          MyVBox.Button.Set_Label ("You pressed");
          ...
       end;
    exception
       when Error : others =>
          Log
          (  "MyApp",
             Log_Level_Critical,
             (  "Fault: "
             &  Exception_Information (Error)
             &  " in On_Button_Click "
          )  );
    end On_Button_Click;

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de


^ permalink raw reply	[relevance 6%]

* Re: Ada in command / control systems
  @ 2019-03-04 14:38  3%                           ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2019-03-04 14:38 UTC (permalink / raw)


On 2019-03-04 08:03, Maciej Sobczak wrote:

> The fact that you can have blocks implemented in some other formalism whenever needed, instead of fighting with the tool, only gives more credibility to modeling.

Rather incompleteness and/or lack of usability.

> Ironically, you do it with Ada, too, when you rely on components (OSs, DBs, middleware, etc.) written in a sane language like C (sorry, could not resist :-) ).

Nothing of these could not be written in Ada in a better and safer way. 
Simulink is a different case. And remember that the starting point of 
the discussion was not merits of a given language. Ada and C share same 
paradigm. C and Simulink is a paradigm change.

> Actually, Ada would be dead already if this possibilities did not exist. Same with modeling.

It would not be Ada if it could not this.

>> Simulink is an example of why this does not work on larger scale. You
>> can have a small subcomponent in Simulink, but all falls apart once you
>> move to larger components and their interplay.
> 
> Still I don't see how this is worse from source code. Things seem to fall apart no matter what we try to stick together. Maybe we're just bad at engineering software.

Everything has its limits, the difference is where these limits are.

>> My suspicion is that
>> there cannot be such thing as a unified model language, in some strong
>> fundamental way.
> 
> I agree here. So let's mix different modeling formalisms when needed. How about a Simulink model that refers to s-functions implemented by generating code from some other modeling tool, like SCADE? There is no need for a unified language if every team member can have their own, right?

You have a huge system integration problems caused by language 
impedance, which becomes impossible when you have to connect models from 
different paradigms. You must break out of one model go to a reasonable 
language and then re-enter into yet another model.

Better. This debunks the whole argument about pseudo-requirements. How 
can you write requirements in a model language bounds of which 
applicability and the role in the whole system is unknown? You must have 
another set of requirements at least to tell which parts of the system 
to be modeled in which modeling language and then what about all the 
places in-between?

> (Yes, it's that bad.)
> 
>> I have crashed compilers, too.
>>
>> Yes, but you do not start patching the object code. Assembler insertions
>> are extremely rare. s-functions is a norm
> 
> You are mixing arguments. Before you have argued that your modeling tool crashed when you have hacked its files by hand (which is hardly an argument against modeling).

The original problem was not crashing but maintainability. It was 
impossible to modify the diagram and fix errors in it. Crashing came later.

> Now you don't like s-functions (which everybody uses elsewhere, see the other posts about Python code in GNAT). Please don't mix these things, so I can debunk them one by one.

Python in GPS is a GPS issue. I don't use Python, I use Ada. The point 
was that you could not use Simulink for most of elementary programming 
tasks. Whatever Python can, Ada can better.

>> you have to break out of the
>> model abstraction and write a lot around it in order to make that puny
>> model work.
> 
> Which is a norm in this industry. All high-level languages rely on modules implemented in other (presumably low-level) languages. Python would not exist if everybody expected it to be functionally closed, instead, everybody is happy with Python calling C functions below it. Same with modeling.

You compare dynamically typed interpreters with domain-specific 
languages. I compare general purpose languages with domain-specific 
ones. Nothing is broken when you call C from Ada, except for special 
cases which illustrate the point. E.g. if you used C for handling Ada 
exceptions or Ada's protected types. Then you would face model breaking 
and all consequences of. And no, this is not normal practice to do. 
Otherwise you are within the model.

>> Companies cannot claim
>> software free of any liability anymore.
> 
> Which is very interesting and I even applaud it. But here we are talking about tools. And it is a long established tradition to verify final software products in a way that recognizes or bypasses tool deficiencies. That is, the safety of airplane does not depend on Simulink crashing or not. In this scheme (and I don't see this scheme going away) the tool vendor does not take any liability for plane crashing.

MathWorks does not sell planes. In this scenario if a vendor (e.g. 
Airbus) will be made liable, if tools will offer no legal protection, it 
will likely reconsider deployment of these. Presently tools play a huge 
role in avoiding liability.

>> Even giants like Facebook and
>> Amazon get charged.
> 
> Because they make final software (tool vendors don't). And as long as these companies believe that modeling allows them to get their stuff released faster, they will use modeling, with all its deficiencies. And tool vendors will do their best to keep this show going.

They do not believe, they know for sure that certain tools are an easy 
path to certification. And my observation is that the West moves away 
from legalism. Whatever law and norms may say, people and companies are 
made liable. So the safety might be imaginary.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de


^ permalink raw reply	[relevance 3%]

* Re: How To Create And Use Memory Map Files
  @ 2019-02-17 22:41  6% ` Rego, P.
  0 siblings, 0 replies; 200+ results
From: Rego, P. @ 2019-02-17 22:41 UTC (permalink / raw)


> How does Ada do memory map files? Can you give me a few small, but easy to read, programs showing the various aspects of using memory map files in Ada?

If I understood you well, you are referring to those Linux memory areas mapped into files under the OS. If so, you can treat them as usual files, eg

   with Text_IO;
   with Ada.Exceptions;
   ...
   declare
      Full_Name : constant String := "/etc/somefile";
      Curr_File : Text_IO.File_Type;
      Cmd : constant String := "5";
   begin
      Text_IO.Open (Curr_File, Text_IO.Out_File, Full_Name);
      Text_IO.Put_Line (Curr_File, Cmd);
      Text_IO.Close (Curr_File);
   exception
      when The_Error : others =>
         Text_IO.Put_Line("!!! "&Ada.Exceptions.Exception_Information (The_Error));
   end;


^ permalink raw reply	[relevance 6%]

* Ada x <whatever> Datagram Sockets
@ 2019-02-06 23:10  6% Rego, P.
  0 siblings, 0 replies; 200+ results
From: Rego, P. @ 2019-02-06 23:10 UTC (permalink / raw)


I am trying to communicate a Windows Ada application with another application in the same machine (an specific C++ porting called MQL) using datagram sockets. The core Ada app was extracted from GNAT.Sockets documentation, from the ping-pong caller. 

with GNAT.Sockets;
with Text_IO;
with Ada.Exceptions; use Ada.Exceptions;

procedure DG_SERVER is
   package SOCKETS renames GNAT.Sockets;
   Socket  : SOCKETS.Socket_Type;
   Address : SOCKETS.Sock_Addr_Type;
   Channel : SOCKETS.Stream_Access;
   Group : constant String := "239.255.128.128";

begin

   SOCKETS.Initialize;
   SOCKETS.Create_Socket (Socket, SOCKETS.Family_Inet, SOCKETS.Socket_Datagram);
   SOCKETS.Set_Socket_Option
     (Socket,
      SOCKETS.Socket_Level,
      (SOCKETS.Reuse_Address, True));
   SOCKETS.Set_Socket_Option
     (Socket,
      SOCKETS.IP_Protocol_For_IP_Level,
      (SOCKETS.Multicast_TTL, 1));
   SOCKETS.Set_Socket_Option
     (Socket,
      SOCKETS.IP_Protocol_For_IP_Level,
      (SOCKETS.Multicast_Loop, True));
   Address.Addr := SOCKETS.Any_Inet_Addr;
   Address.Port := 55505;
   SOCKETS.Bind_Socket (Socket, Address);
   SOCKETS.Set_Socket_Option
     (Socket,
      SOCKETS.IP_Protocol_For_IP_Level,
      (SOCKETS.Add_Membership, SOCKETS.Inet_Addr (Group), SOCKETS.Any_Inet_Addr));
   Address.Addr := SOCKETS.Inet_Addr (Group);
   loop
      Channel := SOCKETS.Stream (Socket, Address);
      declare
         Message : String := String'Input (Channel);
      begin
         Address := SOCKETS.Get_Address (Channel);
         Text_IO.Put_Line (Message & " from " & SOCKETS.Image (Address));
         String'Output (Channel, Message);
      end;
   end loop;
exception
   when The_Error : others =>
      Text_IO.Put_Line("!!! "&Ada.Exceptions.Exception_Information (The_Error));
end DG_SERVER;

The problem is that when I send the message (from MQL side), my Ada server returns

raised GNAT.SOCKETS.SOCKET_ERROR : [10040] Message too long
Call stack traceback locations:
0x424e6c 0x426ddb 0x426e17 0x4200a8 0x42174e 0x4019fc 0x40246d 0x4013db 0x74198482 0x778f3ab6 0x778f3a86

and investigating the libraries, Channel : SOCKETS.Stream_Access will really receive any data size.

So... how can avoid the exception?

Thanks!


^ permalink raw reply	[relevance 6%]

* Re: windows-1251 to utf-8
  @ 2018-11-01 14:34  6%       ` Björn Lundin
  0 siblings, 0 replies; 200+ results
From: Björn Lundin @ 2018-11-01 14:34 UTC (permalink / raw)


On 2018-11-01 14:26, Dmitry A. Kazakov wrote:
> On 2018-11-01 13:49, Björn Lundin wrote:
> 
>> something like (with changes for 1251 instead of Latin_1 to be done)
> 
> You probably mean 1252 which almost Latin-1. 

I do.


> 1251 is totally different.
> it has Cyrillic letters in the upper half of 8-bit codes, in the place
> where 1252 keeps Central European letters with fancy diacritic marks.

And I also found that the code in last post can be replaced by

  -------------------------------------------------------
  function To_Iso_Latin_15(Str : Unicode.CES.Byte_Sequence) return String is
    use Unicode.Encodings;
  begin
    return  Convert(Str  => Str,
                    From => Get_By_Name("utf-8"),
                    To   => Get_By_Name("iso-8859-15"));

  end To_Iso_Latin_15;
  -------------------------------------------------------

I also see that the unicode package in xml/ada has support for
1251 and 1252.

package Unicode.CCS.Windows_1251 is ...

the withs are
with Ada.Exceptions;                   use Ada.Exceptions;
with Unicode.Names.Cyrillic;           use Unicode.Names.Cyrillic;
with Unicode.Names.Basic_Latin;        use Unicode.Names.Basic_Latin;
with Unicode.Names.Latin_1_Supplement; use Unicode.Names.Latin_1_Supplement;
with Unicode.Names.Currency_Symbols;   use Unicode.Names.Currency_Symbols;
with Unicode.Names.General_Punctuation;
use Unicode.Names.General_Punctuation;
with Unicode.Names.Letterlike_Symbols;
use Unicode.Names.Letterlike_Symbols;



which suggests to me that it is the cyrillic one


which (I think) would make the function above


-------------------------------------------------------
  function To_Windows_1251(Str : Unicode.CES.Byte_Sequence) return String is
    use Unicode.Encodings;
  begin
    return  Convert(Str  => Str,
                    From => Get_By_Name("utf-8"),
                    To   => Get_By_Name("Windows-1251"));

  end To_Windows_1251;
  -------------------------------------------------------



-- 
--
Björn

^ permalink raw reply	[relevance 6%]

* Re: GNAT compiler versions and addr2line
  2018-08-22 19:43  6%     ` Anh Vo
@ 2018-08-22 20:30  0%       ` Randy Brukardt
  0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2018-08-22 20:30 UTC (permalink / raw)


I can vouch for the fact that this works on our Debian server. It's a bit 
annoying to have to add code (as it has to be removed again when using the 
same code with other Ada compiler (Janus/Ada in my case), but it works and I 
couldn't really use Ada without it (too used to the Janus/Ada version). At 
least in most cases there are other things (like rep. clauses) that need 
change as well.

                                Randy.

"Anh Vo" <anhvofrcaus@gmail.com> wrote in message 
news:dbf742f5-1bd4-4903-8299-8739e6179bfc@googlegroups.com...
> On Wednesday, August 22, 2018 at 11:21:37 AM UTC-7, Phil wrote:
>> Alejandro R. Mosteo <alejandro@mosteo.com> wrote:
>> > I have seen the same up to current 7.3 FSF Ubuntu versions, and still
>> > haven't found a workaround :/
>>
>> Ah, at least it's not just me!
>
> gnatmake -g foo.adb -bargs -E for the following modified code. You will be 
> pleasantly surprised that addr2line is not needed explicitly.
>
> with Gnat.Traceback.Symbolic;
> with Ada.Exceptions; use Ada;
> with Ada.Text_IO; use Ada.Text_IO;
>
> procedure Foo is
>
>   procedure Able is
>   begin
>      raise Constraint_Error with "It broke";
>   end Able;
>
>   procedure Baker is
>   begin
>      Able;
>   end Baker;
>
> begin
>   Baker;
> exception
>   when Err : others =>
>      Put_Line ("Houston we have a problem: " &
> 
> Exceptions.Exception_Information(Err));
>      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Err));
> end Foo;
>
>
> 



^ permalink raw reply	[relevance 0%]

* Re: GNAT compiler versions and addr2line
  @ 2018-08-22 19:43  6%     ` Anh Vo
  2018-08-22 20:30  0%       ` Randy Brukardt
  0 siblings, 1 reply; 200+ results
From: Anh Vo @ 2018-08-22 19:43 UTC (permalink / raw)


On Wednesday, August 22, 2018 at 11:21:37 AM UTC-7, Phil wrote:
> Alejandro R. Mosteo <alejandro@mosteo.com> wrote:
> > I have seen the same up to current 7.3 FSF Ubuntu versions, and still 
> > haven't found a workaround :/
> 
> Ah, at least it's not just me!

gnatmake -g foo.adb -bargs -E for the following modified code. You will be pleasantly surprised that addr2line is not needed explicitly.

with Gnat.Traceback.Symbolic;
with Ada.Exceptions; use Ada;
with Ada.Text_IO; use Ada.Text_IO;

procedure Foo is 

   procedure Able is 
   begin 
      raise Constraint_Error with "It broke"; 
   end Able; 

   procedure Baker is 
   begin 
      Able; 
   end Baker;

begin 
   Baker; 
exception
   when Err : others =>
      Put_Line ("Houston we have a problem: " &
                                       Exceptions.Exception_Information(Err));
      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Err));
end Foo; 



^ permalink raw reply	[relevance 6%]

* Re: GNAT compiler versions and addr2line
  2018-08-22 13:01  5% GNAT compiler versions and addr2line Phil
@ 2018-08-22 15:14  0% ` Alejandro R. Mosteo
    0 siblings, 1 reply; 200+ results
From: Alejandro R. Mosteo @ 2018-08-22 15:14 UTC (permalink / raw)


On 22/08/18 15:01, Phil wrote:
> Hi,
> 
> I'm having problems getting useful debugging data from some GNAT
> versions.  If I use the Debian FSF version (6.3.0), I get very little
> useful unless running inside gdb.  In particular, the trace addresses
> don't resolve to anything through addr2line.

I have seen the same up to current 7.3 FSF Ubuntu versions, and still 
haven't found a workaround :/

Alex.

> 
> Given this test program:
>      $ cat foo.adb
>      procedure Foo is
> 
>         procedure Able is
>         begin
> 	  raise Constraint_Error with "It broke";
>         end Able;
> 
>         procedure Baker is
>         begin
> 	  Able;
>         end Baker;
> 
>      begin
>         Baker;
>      end Foo;
> 
> Check the compiler version:
> 
>      $ gnatmake --version
>      GNATMAKE 6.3.0
>      […]
> 
> Build with debug info and binder argument -E:
> 
>      $ gnatmake -g foo -bargs -E
>      […]
> 
> Run and try to use addr2line to get more information:
>      $ ./foo
>      Execution terminated by unhandled exception
>      raised CONSTRAINT_ERROR : It broke
>      Call stack traceback locations:
>      0x55654f763530 0x55654f763566 0x55654f76354c 0x55654f7634e8 0x7f11a88292df 0x55654f763238 0xfffffffffffffffe
> 
>      $ addr2line -e foo -f 0x55654f763530 0x55654f763566 0x55654f76354c 0x55654f7634e8 0x7f11a88292df 0x55654f763238 0xfffffffffffffffe
>      ??
>      ??:0
>      […and repeats ??, ??:0…]
> 
> Now, gdb using “catch exception” and “bt” will show some debugging:
>      (gdb) bt
>      #0  <__gnat_debug_raise_exception> (e=0x5555557560c0 <constraint_error>,
> 	message=...) at s-excdeb.adb:40
>      #1  0x00007ffff797603e in ada.exceptions.complete_occurrence (
> 	x=x@entry=0x555555757050) at a-except.adb:925
>      #2  0x00007ffff797604d in ada.exceptions.complete_and_propagate_occurrence (
> 	x=x@entry=0x555555757050) at a-except.adb:936
>      #3  0x00007ffff79760a0 in <__gnat_raise_exception> (
> 	e=0x5555557560c0 <constraint_error>, message=...) at a-except.adb:978
>      #4  0x0000555555555532 in foo.able () at foo.adb:5
>      #5  0x0000555555555568 in foo.baker () at foo.adb:10
>      #6  0x000055555555554e in foo () at foo.adb:14
> So the debugging data is accessible (somehow).
> 
> The same problem occurs with version 7.3.0 (from Debian unstable).  It
> works if I use the current AdaCore community version instead:
> 
>      $ gnatmake --version
>      GNATMAKE Community 2018 (20180524-73)
>      $ ./foo
> 
>      Execution of ./foo terminated by unhandled exception
>      raised CONSTRAINT_ERROR : It broke
>      Call stack traceback locations:
>      0x4024e4 0x402519 0x402500 0x402473 0x7fb92acb72df 0x4020b8 0xfffffffffffffffe
>      $ addr2line -e foo -f 0x4024e4 0x402519 0x402500 0x402473 0x7fb92acb72df 0x4020b8 0xfffffffffffffffe
>      foo__able
>      /tmp/ada/foo.adb:5
>      foo__baker
>      /tmp/ada/foo.adb:10
>      _ada_foo
>      /tmp/ada/foo.adb:14
>      main
>      /tmp/ada/b~foo.adb:185
>      […]
> 
> 
> I started looking at this because of problems using GNAT.Traceback.Symbolic
> (the 6.3.0 version has a stub version isn't useful).  Getting
> addr2line working would be very helpful.  I assume (hope!) it's a
> PBCAK issue — does anyone have a suggestion for getting addr2line
> working with the Debian/FSF versions? Am I missing something on the
> command line?
> 
> TIA,
> 
> Phil.
> 
> 
> 
> 


^ permalink raw reply	[relevance 0%]

* GNAT compiler versions and addr2line
@ 2018-08-22 13:01  5% Phil
  2018-08-22 15:14  0% ` Alejandro R. Mosteo
  0 siblings, 1 reply; 200+ results
From: Phil @ 2018-08-22 13:01 UTC (permalink / raw)


Hi,

I'm having problems getting useful debugging data from some GNAT
versions.  If I use the Debian FSF version (6.3.0), I get very little
useful unless running inside gdb.  In particular, the trace addresses
don't resolve to anything through addr2line.

Given this test program:
    $ cat foo.adb
    procedure Foo is

       procedure Able is
       begin
	  raise Constraint_Error with "It broke";
       end Able;

       procedure Baker is
       begin
	  Able;
       end Baker;

    begin
       Baker;
    end Foo;

Check the compiler version:

    $ gnatmake --version
    GNATMAKE 6.3.0
    […]

Build with debug info and binder argument -E:

    $ gnatmake -g foo -bargs -E
    […]

Run and try to use addr2line to get more information:
    $ ./foo
    Execution terminated by unhandled exception
    raised CONSTRAINT_ERROR : It broke
    Call stack traceback locations:
    0x55654f763530 0x55654f763566 0x55654f76354c 0x55654f7634e8 0x7f11a88292df 0x55654f763238 0xfffffffffffffffe

    $ addr2line -e foo -f 0x55654f763530 0x55654f763566 0x55654f76354c 0x55654f7634e8 0x7f11a88292df 0x55654f763238 0xfffffffffffffffe
    ??
    ??:0
    […and repeats ??, ??:0…]

Now, gdb using “catch exception” and “bt” will show some debugging:
    (gdb) bt
    #0  <__gnat_debug_raise_exception> (e=0x5555557560c0 <constraint_error>, 
	message=...) at s-excdeb.adb:40
    #1  0x00007ffff797603e in ada.exceptions.complete_occurrence (
	x=x@entry=0x555555757050) at a-except.adb:925
    #2  0x00007ffff797604d in ada.exceptions.complete_and_propagate_occurrence (
	x=x@entry=0x555555757050) at a-except.adb:936
    #3  0x00007ffff79760a0 in <__gnat_raise_exception> (
	e=0x5555557560c0 <constraint_error>, message=...) at a-except.adb:978
    #4  0x0000555555555532 in foo.able () at foo.adb:5
    #5  0x0000555555555568 in foo.baker () at foo.adb:10
    #6  0x000055555555554e in foo () at foo.adb:14
So the debugging data is accessible (somehow).

The same problem occurs with version 7.3.0 (from Debian unstable).  It
works if I use the current AdaCore community version instead:

    $ gnatmake --version
    GNATMAKE Community 2018 (20180524-73)
    $ ./foo 

    Execution of ./foo terminated by unhandled exception
    raised CONSTRAINT_ERROR : It broke
    Call stack traceback locations:
    0x4024e4 0x402519 0x402500 0x402473 0x7fb92acb72df 0x4020b8 0xfffffffffffffffe
    $ addr2line -e foo -f 0x4024e4 0x402519 0x402500 0x402473 0x7fb92acb72df 0x4020b8 0xfffffffffffffffe
    foo__able
    /tmp/ada/foo.adb:5
    foo__baker
    /tmp/ada/foo.adb:10
    _ada_foo
    /tmp/ada/foo.adb:14
    main
    /tmp/ada/b~foo.adb:185
    […]


I started looking at this because of problems using GNAT.Traceback.Symbolic
(the 6.3.0 version has a stub version isn't useful).  Getting
addr2line working would be very helpful.  I assume (hope!) it's a
PBCAK issue — does anyone have a suggestion for getting addr2line
working with the Debian/FSF versions? Am I missing something on the
command line?

TIA,

Phil.





^ permalink raw reply	[relevance 5%]

* Re: GNAT user-specified (via Raise_Exception) warning message size limit
  2018-02-16 18:44  6% GNAT user-specified (via Raise_Exception) warning message size limit marciant
  2018-02-16 18:59  0% ` Per Sandberg
@ 2018-02-17  0:03  0% ` Randy Brukardt
  1 sibling, 0 replies; 200+ results
From: Randy Brukardt @ 2018-02-17  0:03 UTC (permalink / raw)


<marciant@earthlink.net> wrote in message 
news:789f6417-5e6f-4d5f-8abb-80246f4f405a@googlegroups.com...
...
>It seems that although quite long messages are accepted at calls to it, the
>message then retrieved and printed within a handler that uses
>Ada.Exceptions.Exception_Message on the occurrence only returns a
>truncated part of the original message - around the first 200 characters
>are returned and the rest is truncated.

For what it's worth, portable Ada code should not depend on exception 
messages longer than 200 characters, see RM 11.4.1(18).

For Janus/Ada, the truncation happens because an exception occurrence only 
has space for 200 characters. One could change the limited, but 
recompilation of the runtime clearly would be needed since it would change 
the definition/representation of the Exception_Occurrence type.

It sounds like GNAT is similar.

                                                 Randy.



^ permalink raw reply	[relevance 0%]

* Re: GNAT user-specified (via Raise_Exception) warning message size limit
  2018-02-16 18:44  6% GNAT user-specified (via Raise_Exception) warning message size limit marciant
@ 2018-02-16 18:59  0% ` Per Sandberg
  2018-02-17  0:03  0% ` Randy Brukardt
  1 sibling, 0 replies; 200+ results
From: Per Sandberg @ 2018-02-16 18:59 UTC (permalink / raw)


Well
 From a quick glance i would expect the answer to be:

In package System.Parameters update the value of
	"Default_Exception_Msg_Max_Length"  to a new value.
And recompile the run-times.

/P


Den 2018-02-16 kl. 19:44, skrev marciant@earthlink.net:
> Hello,
> 
> Before I see about asking AdaCore directly via GNAT Tracker, I thought that I'd ask here first:
> 
> Is there a way to increase the default size limit of the exception message that is specified when calling Ada.Exceptions.Raise_Exception?
> 
> It seems that although quite long messages are accepted at calls to it, the message then retrieved and printed within a handler that uses Ada.Exceptions.Exception_Message on the occurrence only returns a truncated part of the original message - around the first 200 characters are returned and the rest is truncated.
> 
> Vincent Marciante
> 

^ permalink raw reply	[relevance 0%]

* GNAT user-specified (via Raise_Exception) warning message size limit
@ 2018-02-16 18:44  6% marciant
  2018-02-16 18:59  0% ` Per Sandberg
  2018-02-17  0:03  0% ` Randy Brukardt
  0 siblings, 2 replies; 200+ results
From: marciant @ 2018-02-16 18:44 UTC (permalink / raw)


Hello,

Before I see about asking AdaCore directly via GNAT Tracker, I thought that I'd ask here first:

Is there a way to increase the default size limit of the exception message that is specified when calling Ada.Exceptions.Raise_Exception?

It seems that although quite long messages are accepted at calls to it, the message then retrieved and printed within a handler that uses Ada.Exceptions.Exception_Message on the occurrence only returns a truncated part of the original message - around the first 200 characters are returned and the rest is truncated.

Vincent Marciante

^ permalink raw reply	[relevance 6%]

* Re: Exception_Occurence and language designers
  @ 2017-12-04 17:43  6% ` Jeffrey R. Carter
  0 siblings, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2017-12-04 17:43 UTC (permalink / raw)


Exceptions are subject to Ada's visibility rules. In Ada 83, you could have

with Text_IO;
procedure Foobar is
    procedure Foo is
       Bar : exception;
    begin -- Foo
       raise Bar;
    end Foo;
begin -- Foobar
    Foo;
exception -- Foobar
when others => -- Bar is not visible here
    Text_IO.Put_Line (Item => "An exception occurred");
end Foobar;

Even though Bar is not visible outside Foo, it can still propagate out to Foobar 
and be handled by an others handler. It was impossible from that handler to know 
what has been handled.

Ada.Exceptions is a way to get around these limitations with minimum impact on 
backwards compatibility.

-- 
Jeff Carter
"I would never want to belong to any club that
would have someone like me for a member."
Annie Hall
41

^ permalink raw reply	[relevance 6%]

* Re: Ada.Strings.Unbounded vs Ada.Containers.Indefinite_Holders
  @ 2017-09-23  9:16  5%           ` Jeffrey R. Carter
  0 siblings, 0 replies; 200+ results
From: Jeffrey R. Carter @ 2017-09-23  9:16 UTC (permalink / raw)


On 09/23/2017 10:09 AM, Dmitry A. Kazakov wrote:
> On 2017-09-23 00:15, Victor Porton wrote:
>>
>> In my opinion, it would be better to change RM phrasing from "null string"
>> to "empty string", because in some other languages (notably C) NULL means
>> something other. It is just confusing.
> 
> The adjective null and the noun null are distinct parts of speech. C's noun null 
> is an abbreviation of null pointer. If pointers can be null so strings can.

Another way to look at it: Ada has the formal concepts of:

* null access value ARM 4.2(9)
* null array 3.6.1(7)
* null constraint 3.2(7/2)
* null_exclusion 3.10(5.1/2)
* null extension 3.9.1(4.1/2)
* null procedure 6.7(3/3)
* null range 3.5(4)
* null record 3.8(15)
* null slice 4.1.2(7)
* null string literal 2.6(6)
* null value (of an access type) 3.10(13/2)
* null_statement 5.1(6)

not to mention the language-defined identifiers

Null_Address
    in System   13.7(12)
Null_Bounded_String
    in Ada.Strings.Bounded   A.4.4(7)
Null_Id
    in Ada.Exceptions   11.4.1(2/2)
Null_Occurrence
    in Ada.Exceptions   11.4.1(3/2)
Null_Ptr
    in Interfaces.C.Strings   B.3.1(7)
Null_Set
    in Ada.Strings.Maps   A.4.2(5)
    in Ada.Strings.Wide_Maps   A.4.7(5)
    in Ada.Strings.Wide_Wide_Maps   A.4.8(5/2)
Null_Task_Id
    in Ada.Task_Identification   C.7.1(2/2)
Null_Unbounded_String
    in Ada.Strings.Unbounded   A.4.5(5)

(Just look under N in the index.)

It's called overloading. Many of these cases refer to things that can have 
components and mean one with zero components: a null record has no components, a 
null array has no components ('Length = 0), a null string literal has no 
characters, a null set has no members, ... It should not be confusing.

-- 
Jeff Carter
"You cheesy lot of second-hand electric donkey-bottom biters."
Monty Python & the Holy Grail
14

^ permalink raw reply	[relevance 5%]

* Re: NTP
  @ 2017-09-16  9:29  5% ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2017-09-16  9:29 UTC (permalink / raw)


On 2017-09-16 08:40, Anatoly Chernyshev wrote:

> Is there a way to get time via the Network Time Protocol in Ada? It
> doesn't look like AWS has it (or I've missed something).
> 
> Currently I'm getting around spawning the Cygwin "nc" command, but it hurts my feelings.

Do you mean send a single UDP request to an NTP server and convert the 
response to Ada time?

You can try this:
----------------------------------------------------------------------
with Ada.Text_IO;              use Ada.Text_IO;
with Ada.Calendar;             use Ada.Calendar;
with Ada.Calendar.Formatting;  use Ada.Calendar.Formatting;
with Ada.Exceptions;           use Ada.Exceptions;
with Ada.Streams;              use Ada.Streams;
with GNAT.Sockets;             use GNAT.Sockets;
with Interfaces;               use Interfaces;

procedure Test is

    function Get_NTP_Time
             (  Server  : String;
                Timeout : Timeval_Duration := 10.0
             )  return Time is
       NTP_Packet_Size : constant := 48;
          -- RFC 5905: Official NTP era begins at 1 Jan 1900. We cannot
          -- have it in Ada.Calendar.Time, so taking a later time. Note
          -- Time_Zone = 0 in order to have it UTC
       Era : constant Time := Time_Of (1999, 12, 31, Time_Zone => 0);
          -- RFC 5905: seconds since 1 Jan 1900 to 31 Dec 1999
       Era_Offset : constant := 3_155_587_200;

       Socket   : Socket_Type;
       Address  : Sock_Addr_Type;
       Seconds  : Unsigned_32;
       Fraction : Unsigned_32;
       Last     : Stream_Element_Offset;
       Data     : Stream_Element_Array (1..NTP_Packet_Size) :=
                     (  1  => 2#1110_0011#, -- LI, Version, Mode
                        2  => 0,            -- Stratum, or type of clock
                        3  => 0,            -- Polling Interval
                        4  => 16#EC#,       -- Peer Clock Precision
                        13 => 49,
                        14 => 16#4E#,
                        15 => 49,
                        16 => 52,
                        others => 0
                     );
    begin
       Address.Addr := Addresses (Get_Host_By_Name (Server), 1);
       Address.Port := 123; -- NTP port
       Create_Socket (Socket, Family_Inet, Socket_Datagram);
       Set_Socket_Option
       (  Socket,
          Socket_Level,
          (Receive_Timeout, Timeout)
       );
       Send_Socket (Socket, Data, Last, Address);
       Receive_Socket (Socket, Data, Last, Address);
       if Last /= Data'Last then
          Raise_Exception (Data_Error'Identity, "Mangled response");
       end if;
       Seconds := (  Unsigned_32 (Data (41)) * 2**24
                  +  Unsigned_32 (Data (42)) * 2**16
                  +  Unsigned_32 (Data (43)) * 2**8
                  +  Unsigned_32 (Data (44))
                  -  Era_OFfset
                  );
       Fraction := (  Unsigned_32 (Data (45)) * 2**24
                   +  Unsigned_32 (Data (46)) * 2**16
                   +  Unsigned_32 (Data (47)) * 2**8
                   +  Unsigned_32 (Data (48))
                   );
       return (  Era
              +  Duration (Seconds)
         --     +  Duration (Long_Float (Fraction) / 2.0**32)
              );
    end Get_NTP_Time;

    Stamp : Time;
begin
    Stamp := Get_NTP_Time ("time.nist.gov");
    Put_Line ("NTP time " & Image (Stamp));
exception
    when Error : others =>
       Put_Line ("Error: " & Exception_Information (Error));
end Test;
-------------------------------------------------------------------

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 5%]

* Re: Unhandled Exception in Tartan generated code for M68040
  2017-08-08  5:33  0%       ` Petter Fryklund
@ 2017-08-16 11:04  0%         ` Petter Fryklund
  0 siblings, 0 replies; 200+ results
From: Petter Fryklund @ 2017-08-16 11:04 UTC (permalink / raw)


Den tisdag 8 augusti 2017 kl. 07:33:07 UTC+2 skrev Petter Fryklund:
> Den måndag 7 augusti 2017 kl. 08:21:29 UTC+2 skrev Niklas Holsti:
> > On 17-08-07 08:48 , Petter Fryklund wrote:
> > > Den onsdag 12 juli 2017 kl. 21:30:28 UTC+2 skrev Niklas Holsti:
> > >> On 17-07-07 12:58 , Petter Fryklund wrote:
> > >>> Hi, I'm trying to locate an Unhandled Exception. The printout
> > >>> received is
> > >>>
> > >>> Unhandled Exception vector 37 at 45E6C
> > >>>
> > >>> or
> > >>>
> > >>> Unhandled Exception vector 18 at 10A40E
> > >>>
> > >>> I assume there is a way to use the .map file to find out where these
> > >>> exceptions occur, but endless googling has come up with nil.
> > >>
> > >> And in another message, Petter continued:
> > >>
> > >>  > the Unexpected Exception is erronous, the code has exception
> > >>  > handler everywhere.
> > >>
> > >> Are you sure, Petter, that "exception" in "Unhandled Exception" means an
> > >> Ada exception? I seem to remember that some processors use the term
> > >> "exception" for what is more commonly called a "trap". Perhaps these are
> > >> HW traps that are _not_ mapped to Ada exceptions?
> > >>
> > >> The Wikipedia page on M68000
> > >> (https://en.wikipedia.org/wiki/Motorola_68000_series) uses the term
> > >> "exception" for HW events,and so does the M68040 User Manual
> > >> (http://cache.freescale.com/files/32bit/doc/ref_manual/MC68040UM.pdf).
> > >>
> > >> Table 8-1 in the User Manual lists these HW exceptions, by number. It
> > >> seems that numbers 32..47 are of SW origin, triggered by the TRAP
> > >> instruction, while number 18 is described as "Unassigned, Reserved".
> > >> Numbers 25..31 are "Interrupt Autovectors". This suggests that these HW
> > >> exceptions should be treated as interrupts in the Ada program, that is,
> > >> processed by interrupt handlers, not by exception handlers. On the other
> > >> hand, the Tartan run-time system may map some of these HW exceptions to
> > >> Ada exceptions, for example number 5, which is "Integer Divide by Zero".
> > >>
> > >> (Disclaimer: I know nothing about the Tartan compiler.)
> > >>
> > >> --
> > >> Niklas Holsti
> > >> Tidorum Ltd
> > >> niklas holsti tidorum fi
> > >>        .      @       .
> > >
> > > Thanks for responding, Niklas.
> > > Your suggestion makes sense since one would expect the program to stop
> > > on an Unhandled Exception, but it continues.
> > 
> > It is not evident what one would expect. Standard Ada says that an 
> > unhandled Ada exception in a task should terminate that task (which 
> > usually happens silently), but the other tasks should continue.
> > 
> > If your Unhandled Exceptions are not Ada exceptions, but HW traps, and 
> > the program is embedded, the system designer may prefer to have the 
> > program continue after an unexpected (unhandled) HW trap, or have it 
> > stop, depending on the criticality (safety requirements) of the program 
> > and on the presence or absence of redundancy or fail-safe external 
> > subsystems.
> > 
> > The Ariane 501 accident is an example where stopping the program was the 
> > wrong action in that context.
> > 
> > > But I cannot figure out
> > > what the 6 digit hex number is in that case.
> > 
> > I would expect the number to be the memory address of the instruction at 
> > which the HW trap occurred (whether or not this instruction is the 
> > direct cause of the trap). I assume you have searched the .map file for 
> > these addresses, but usually the .map does not contain the address of 
> > every instruction, only of the subprogram entry points. By comparing the 
> > hex numbers with the subprogram entry points, and assuming that all code 
> > in subprogram A lies between the entry point of A and the next entry 
> > point in address order (which is not a safe assumption for all 
> > compilers), you should be able to find the subprogram that contains the 
> > relevant instruction.
> > 
> > Or you could ask for a full disassembly of the program and search there 
> > for these hex numbers.
> > 
> > -- 
> > Niklas Holsti
> > Tidorum Ltd
> > niklas holsti tidorum fi
> >        .      @       .
> 
> Hi again.
> I've inspected the s-record file and it seems like the printout comes from the runtime unit unhandledexception in the standalone runtime. There are only a few tasks in the program and one of them doesn't have exception handlers. So I will fix that and see what the root cause is.
> 
> Regards,
> Petter

I think that exceptions raise from an exception handler can cause unhandled exception if there is no handler one level up. 

I've learned that the hexadecimal value is indeed an address that can be matched to the .map file produced by the build.

Regards,
Petter

^ permalink raw reply	[relevance 0%]

* Re: Unhandled Exception in Tartan generated code for M68040
  2017-08-07  6:21  5%     ` Niklas Holsti
@ 2017-08-08  5:33  0%       ` Petter Fryklund
  2017-08-16 11:04  0%         ` Petter Fryklund
  0 siblings, 1 reply; 200+ results
From: Petter Fryklund @ 2017-08-08  5:33 UTC (permalink / raw)


Den måndag 7 augusti 2017 kl. 08:21:29 UTC+2 skrev Niklas Holsti:
> On 17-08-07 08:48 , Petter Fryklund wrote:
> > Den onsdag 12 juli 2017 kl. 21:30:28 UTC+2 skrev Niklas Holsti:
> >> On 17-07-07 12:58 , Petter Fryklund wrote:
> >>> Hi, I'm trying to locate an Unhandled Exception. The printout
> >>> received is
> >>>
> >>> Unhandled Exception vector 37 at 45E6C
> >>>
> >>> or
> >>>
> >>> Unhandled Exception vector 18 at 10A40E
> >>>
> >>> I assume there is a way to use the .map file to find out where these
> >>> exceptions occur, but endless googling has come up with nil.
> >>
> >> And in another message, Petter continued:
> >>
> >>  > the Unexpected Exception is erronous, the code has exception
> >>  > handler everywhere.
> >>
> >> Are you sure, Petter, that "exception" in "Unhandled Exception" means an
> >> Ada exception? I seem to remember that some processors use the term
> >> "exception" for what is more commonly called a "trap". Perhaps these are
> >> HW traps that are _not_ mapped to Ada exceptions?
> >>
> >> The Wikipedia page on M68000
> >> (https://en.wikipedia.org/wiki/Motorola_68000_series) uses the term
> >> "exception" for HW events,and so does the M68040 User Manual
> >> (http://cache.freescale.com/files/32bit/doc/ref_manual/MC68040UM.pdf).
> >>
> >> Table 8-1 in the User Manual lists these HW exceptions, by number. It
> >> seems that numbers 32..47 are of SW origin, triggered by the TRAP
> >> instruction, while number 18 is described as "Unassigned, Reserved".
> >> Numbers 25..31 are "Interrupt Autovectors". This suggests that these HW
> >> exceptions should be treated as interrupts in the Ada program, that is,
> >> processed by interrupt handlers, not by exception handlers. On the other
> >> hand, the Tartan run-time system may map some of these HW exceptions to
> >> Ada exceptions, for example number 5, which is "Integer Divide by Zero".
> >>
> >> (Disclaimer: I know nothing about the Tartan compiler.)
> >>
> >> --
> >> Niklas Holsti
> >> Tidorum Ltd
> >> niklas holsti tidorum fi
> >>        .      @       .
> >
> > Thanks for responding, Niklas.
> > Your suggestion makes sense since one would expect the program to stop
> > on an Unhandled Exception, but it continues.
> 
> It is not evident what one would expect. Standard Ada says that an 
> unhandled Ada exception in a task should terminate that task (which 
> usually happens silently), but the other tasks should continue.
> 
> If your Unhandled Exceptions are not Ada exceptions, but HW traps, and 
> the program is embedded, the system designer may prefer to have the 
> program continue after an unexpected (unhandled) HW trap, or have it 
> stop, depending on the criticality (safety requirements) of the program 
> and on the presence or absence of redundancy or fail-safe external 
> subsystems.
> 
> The Ariane 501 accident is an example where stopping the program was the 
> wrong action in that context.
> 
> > But I cannot figure out
> > what the 6 digit hex number is in that case.
> 
> I would expect the number to be the memory address of the instruction at 
> which the HW trap occurred (whether or not this instruction is the 
> direct cause of the trap). I assume you have searched the .map file for 
> these addresses, but usually the .map does not contain the address of 
> every instruction, only of the subprogram entry points. By comparing the 
> hex numbers with the subprogram entry points, and assuming that all code 
> in subprogram A lies between the entry point of A and the next entry 
> point in address order (which is not a safe assumption for all 
> compilers), you should be able to find the subprogram that contains the 
> relevant instruction.
> 
> Or you could ask for a full disassembly of the program and search there 
> for these hex numbers.
> 
> -- 
> Niklas Holsti
> Tidorum Ltd
> niklas holsti tidorum fi
>        .      @       .

Hi again.
I've inspected the s-record file and it seems like the printout comes from the runtime unit unhandledexception in the standalone runtime. There are only a few tasks in the program and one of them doesn't have exception handlers. So I will fix that and see what the root cause is.

Regards,
Petter


^ permalink raw reply	[relevance 0%]

* Re: Unhandled Exception in Tartan generated code for M68040
  2017-08-07  5:48  0%   ` Petter Fryklund
@ 2017-08-07  6:21  5%     ` Niklas Holsti
  2017-08-08  5:33  0%       ` Petter Fryklund
  0 siblings, 1 reply; 200+ results
From: Niklas Holsti @ 2017-08-07  6:21 UTC (permalink / raw)


On 17-08-07 08:48 , Petter Fryklund wrote:
> Den onsdag 12 juli 2017 kl. 21:30:28 UTC+2 skrev Niklas Holsti:
>> On 17-07-07 12:58 , Petter Fryklund wrote:
>>> Hi, I'm trying to locate an Unhandled Exception. The printout
>>> received is
>>>
>>> Unhandled Exception vector 37 at 45E6C
>>>
>>> or
>>>
>>> Unhandled Exception vector 18 at 10A40E
>>>
>>> I assume there is a way to use the .map file to find out where these
>>> exceptions occur, but endless googling has come up with nil.
>>
>> And in another message, Petter continued:
>>
>>  > the Unexpected Exception is erronous, the code has exception
>>  > handler everywhere.
>>
>> Are you sure, Petter, that "exception" in "Unhandled Exception" means an
>> Ada exception? I seem to remember that some processors use the term
>> "exception" for what is more commonly called a "trap". Perhaps these are
>> HW traps that are _not_ mapped to Ada exceptions?
>>
>> The Wikipedia page on M68000
>> (https://en.wikipedia.org/wiki/Motorola_68000_series) uses the term
>> "exception" for HW events,and so does the M68040 User Manual
>> (http://cache.freescale.com/files/32bit/doc/ref_manual/MC68040UM.pdf).
>>
>> Table 8-1 in the User Manual lists these HW exceptions, by number. It
>> seems that numbers 32..47 are of SW origin, triggered by the TRAP
>> instruction, while number 18 is described as "Unassigned, Reserved".
>> Numbers 25..31 are "Interrupt Autovectors". This suggests that these HW
>> exceptions should be treated as interrupts in the Ada program, that is,
>> processed by interrupt handlers, not by exception handlers. On the other
>> hand, the Tartan run-time system may map some of these HW exceptions to
>> Ada exceptions, for example number 5, which is "Integer Divide by Zero".
>>
>> (Disclaimer: I know nothing about the Tartan compiler.)
>>
>> --
>> Niklas Holsti
>> Tidorum Ltd
>> niklas holsti tidorum fi
>>        .      @       .
>
> Thanks for responding, Niklas.
> Your suggestion makes sense since one would expect the program to stop
> on an Unhandled Exception, but it continues.

It is not evident what one would expect. Standard Ada says that an 
unhandled Ada exception in a task should terminate that task (which 
usually happens silently), but the other tasks should continue.

If your Unhandled Exceptions are not Ada exceptions, but HW traps, and 
the program is embedded, the system designer may prefer to have the 
program continue after an unexpected (unhandled) HW trap, or have it 
stop, depending on the criticality (safety requirements) of the program 
and on the presence or absence of redundancy or fail-safe external 
subsystems.

The Ariane 501 accident is an example where stopping the program was the 
wrong action in that context.

> But I cannot figure out
> what the 6 digit hex number is in that case.

I would expect the number to be the memory address of the instruction at 
which the HW trap occurred (whether or not this instruction is the 
direct cause of the trap). I assume you have searched the .map file for 
these addresses, but usually the .map does not contain the address of 
every instruction, only of the subprogram entry points. By comparing the 
hex numbers with the subprogram entry points, and assuming that all code 
in subprogram A lies between the entry point of A and the next entry 
point in address order (which is not a safe assumption for all 
compilers), you should be able to find the subprogram that contains the 
relevant instruction.

Or you could ask for a full disassembly of the program and search there 
for these hex numbers.

-- 
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
       .      @       .

^ permalink raw reply	[relevance 5%]

* Re: Unhandled Exception in Tartan generated code for M68040
  2017-07-12 19:30  7% ` Niklas Holsti
@ 2017-08-07  5:48  0%   ` Petter Fryklund
  2017-08-07  6:21  5%     ` Niklas Holsti
  0 siblings, 1 reply; 200+ results
From: Petter Fryklund @ 2017-08-07  5:48 UTC (permalink / raw)


Den onsdag 12 juli 2017 kl. 21:30:28 UTC+2 skrev Niklas Holsti:
> On 17-07-07 12:58 , Petter Fryklund wrote:
> > Hi, I'm trying to locate an Unhandled Exception. The printout
> > received is
> >
> > Unhandled Exception vector 37 at 45E6C
> >
> > or
> >
> > Unhandled Exception vector 18 at 10A40E
> >
> > I assume there is a way to use the .map file to find out where these
> > exceptions occur, but endless googling has come up with nil.
> 
> And in another message, Petter continued:
> 
>  > the Unexpected Exception is erronous, the code has exception
>  > handler everywhere.
> 
> Are you sure, Petter, that "exception" in "Unhandled Exception" means an 
> Ada exception? I seem to remember that some processors use the term 
> "exception" for what is more commonly called a "trap". Perhaps these are 
> HW traps that are _not_ mapped to Ada exceptions?
> 
> The Wikipedia page on M68000 
> (https://en.wikipedia.org/wiki/Motorola_68000_series) uses the term 
> "exception" for HW events,and so does the M68040 User Manual 
> (http://cache.freescale.com/files/32bit/doc/ref_manual/MC68040UM.pdf).
> 
> Table 8-1 in the User Manual lists these HW exceptions, by number. It 
> seems that numbers 32..47 are of SW origin, triggered by the TRAP 
> instruction, while number 18 is described as "Unassigned, Reserved". 
> Numbers 25..31 are "Interrupt Autovectors". This suggests that these HW 
> exceptions should be treated as interrupts in the Ada program, that is, 
> processed by interrupt handlers, not by exception handlers. On the other 
> hand, the Tartan run-time system may map some of these HW exceptions to 
> Ada exceptions, for example number 5, which is "Integer Divide by Zero".
> 
> (Disclaimer: I know nothing about the Tartan compiler.)
> 
> -- 
> Niklas Holsti
> Tidorum Ltd
> niklas holsti tidorum fi
>        .      @       .

Thanks for responding, Niklas.
Your suggestion makes sense since one would expect the program to stop on an Unhandled Exception, but it continues. But I cannot figure out what the 6 digit hex number is in that case.

Regards,
Petter 

^ permalink raw reply	[relevance 0%]

* Re: Unhandled Exception in Tartan generated code for M68040
  @ 2017-07-12 19:30  7% ` Niklas Holsti
  2017-08-07  5:48  0%   ` Petter Fryklund
  0 siblings, 1 reply; 200+ results
From: Niklas Holsti @ 2017-07-12 19:30 UTC (permalink / raw)


On 17-07-07 12:58 , Petter Fryklund wrote:
> Hi, I'm trying to locate an Unhandled Exception. The printout
> received is
>
> Unhandled Exception vector 37 at 45E6C
>
> or
>
> Unhandled Exception vector 18 at 10A40E
>
> I assume there is a way to use the .map file to find out where these
> exceptions occur, but endless googling has come up with nil.

And in another message, Petter continued:

 > the Unexpected Exception is erronous, the code has exception
 > handler everywhere.

Are you sure, Petter, that "exception" in "Unhandled Exception" means an 
Ada exception? I seem to remember that some processors use the term 
"exception" for what is more commonly called a "trap". Perhaps these are 
HW traps that are _not_ mapped to Ada exceptions?

The Wikipedia page on M68000 
(https://en.wikipedia.org/wiki/Motorola_68000_series) uses the term 
"exception" for HW events,and so does the M68040 User Manual 
(http://cache.freescale.com/files/32bit/doc/ref_manual/MC68040UM.pdf).

Table 8-1 in the User Manual lists these HW exceptions, by number. It 
seems that numbers 32..47 are of SW origin, triggered by the TRAP 
instruction, while number 18 is described as "Unassigned, Reserved". 
Numbers 25..31 are "Interrupt Autovectors". This suggests that these HW 
exceptions should be treated as interrupts in the Ada program, that is, 
processed by interrupt handlers, not by exception handlers. On the other 
hand, the Tartan run-time system may map some of these HW exceptions to 
Ada exceptions, for example number 5, which is "Integer Divide by Zero".

(Disclaimer: I know nothing about the Tartan compiler.)

-- 
Niklas Holsti
Tidorum Ltd
niklas holsti tidorum fi
       .      @       .


^ permalink raw reply	[relevance 7%]

* GNAT.Sockets Streaming inefficiency
@ 2017-06-08 10:36  6% masterglob
  0 siblings, 0 replies; 200+ results
From: masterglob @ 2017-06-08 10:36 UTC (permalink / raw)


Configuration: X64, Linux & Windows (GNATPRO 7.4.2)
While using GNAT.Sockets.Stream_Access, there is a real performance issue while using String'Output(...).

My test sends 500 times a 1024-long String using String'Output(TCP_Stream on 127.0.0.1) and the result is:
- Linux : average 'output duration = 3 us
- Windows: average 'output duration = 250 us

From prior discussion with AdaCore, the "String" type is the only one for which this latency is NOT observed on Linux.

Any idea on:
- is there a way to get similar performance on Windows (maybe using another type or method?)
- is there any configuration that may solve this issue?


=============
Result on W7/64
---------
OS=Windows_NT  cygwin
GNAT Pro 7.4.2 (20160527-49)
[SERVER] start...
[SERVER]:bind... 127.0.0.1:4264
[CLIENT] connected...
[SERVER]:connection from 127.0.0.1:56008
[SERVER] Sending 500 messages ...
[CLIENT] waiting for 500 messages ...
[CLIENT]:execution time:  0.000000000
[Server] execution time ( 500msg):  0.140400900 s
[Server] Output_Exec time (1 msg):  0.280801800 ms
[Server] Output_Duration time (1 msg):  0.263417164 ms

=============
Result on Ubuntu/64
---------
OS= 
GNAT Pro 7.4.2 (20160527-49)
[SERVER] start...
[SERVER]:bind... 127.0.0.1:4264
[SERVER]:connection from 127.0.0.1:52574
[CLIENT] connected...
[SERVER] Sending 500 messages ...
[CLIENT] waiting for 500 messages ...
[Server] execution time ( 500msg):  0.001783393 s
[Server] Output_Exec time (1 msg):  0.003072174 ms
[Server] Output_Duration time (1 msg):  0.003204778 ms
[CLIENT]:execution time:  0.001561405

=============
Makefile:
---------
all:build exec
build:
	@gprbuild -p -Ptest_stream_socket_string.gpr
exec: 
	@echo "OS=$$OS  $$OSTYPE"
	@echo $$(gnat --version|head -1)
	@obj/test_stream_socket_string



=============
test_stream_socket_string.gpr:
---------
project Test_Stream_Socket_String is

   for Object_Dir  use "obj";
   for Exec_Dir    use "obj";
   for Main        use ("test_stream_socket_string.adb");
   for Source_Dirs use (".");
   for Languages use ("Ada");

   package Builder is
      for Default_Switches ("Ada") use ("-g","-s","-j0");
   end Builder;

   package Compiler is
      Ada_Opt   := ("-O0");
      Ada_Comp    := ("-gnat12","-g","-gnatU","-gnato","-gnatVa","-fstack-check","-fstack-usage","-gnateE","-gnateF");
      Ada_Style   := ("-gnaty3aAbBCdefhiklL15M120nOprStux");
      Ada_Warning := ("-gnatwah.h.o.st.w");
      for Default_Switches ("Ada") use Ada_Opt & Ada_Comp & Ada_Warning & Ada_Style;
   end Compiler;

   package Binder is
      for Default_Switches ("Ada") use ("-v","-E","-R","-T0");
   end Binder;

   package Linker is
      for Default_Switches ("Ada") use ("-g","-v") ;
   end Linker;

end Test_Stream_Socket_String;



=============
test_stream_socket_string.adb
---------
with Ada.Execution_Time,
     Ada.Real_Time,
     Ada.Text_IO,
     Ada.Exceptions,

     GNAT.Sockets,
     GNAT.Traceback.Symbolic,
     GNAT.OS_Lib;
use GNAT,
    Ada;

use type GNAT.Sockets.Selector_Status,
         Ada.Real_Time.Time,
         Ada.Execution_Time.CPU_Time;

procedure Test_Stream_Socket_String is

   Port    : constant Sockets.Port_Type := 4264;
   Ip_Addr : constant String := "127.0.0.1";

   task type Client_Thread_T is
      entry Start;
      entry Synch;
      entry Wait;
   end Client_Thread_T;
   Client_Thread : Client_Thread_T;
   task type Server_Thread_T is
      entry Start;
      entry Wait;
   end Server_Thread_T;
   Server_Thread : Server_Thread_T;
   
   task body Client_Thread_T is
   
   task body Server_Thread_T is
      Nb_Loop         : constant := 500;
      Cpt             : Integer := Nb_Loop;
      Msg_Size        : constant :=  1024; -- 1 Ko
      Exec_Start_Time : Execution_Time.CPU_Time;
      Exec_Output1    : Execution_Time.CPU_Time;
      Exec_Output2    : Real_Time.Time;
      Output_Exec     : Duration := 0.0;
      Output_Duration : Duration := 0.0;
      Listen          : Sockets.Socket_Type;
      Client          : Sockets.Socket_Type;
      Address         : Sockets.Sock_Addr_Type := (Family => Sockets.Family_Inet,
                                                   Addr   => Sockets.Inet_Addr (Ip_Addr),
                                                   Port   => Port);
      Channel         : Sockets.Stream_Access;
   begin
      accept Start;
      Text_IO.Put_Line ("[SERVER] start...");

      Sockets.Create_Socket (Socket => Listen);
      Text_IO.Put_Line ("[SERVER]:bind... " & Sockets.Image (Address));
      Sockets.Bind_Socket (Socket  => Listen,
                           Address => Address);
      Sockets.Listen_Socket (Listen);

      Sockets.Accept_Socket (Listen, Client, Address);
      Text_IO.Put_Line ("[SERVER]:connection from " & Sockets.Image (Sockets.Get_Peer_Name (Client)));
      Channel := Sockets.Stream (Socket => Client);
      Exec_Start_Time := Execution_Time.Clock;

      Integer'Output (Channel, Cpt);
         Text_IO.Put_Line ("[SERVER] Sending" & Cpt'Img & " messages ...");
      
      while Cpt > 0 loop
         -- Text_IO.Put ('+');
         declare
            S : constant String (1 .. Msg_Size) := (others => '?');
         begin
            Exec_Output1 := Execution_Time.Clock;
            Exec_Output2 := Real_Time.Clock;
            String'Output (Channel, S);
            Output_Exec := Output_Exec + 
              Real_Time.To_Duration (Execution_Time.Clock - Exec_Output1);
            Output_Duration := Output_Duration + 
              Real_Time.To_Duration (Real_Time.Clock - Exec_Output2);
         end;

         Cpt := Cpt - 1;

      end loop;

      Text_IO.Put_Line ("[Server] execution time (" & Nb_Loop'Img & "msg): " &
                          Real_Time.To_Duration (Execution_Time.Clock - Exec_Start_Time)'Img & " s");

      Text_IO.Put_Line ("[Server] Output_Exec time (1 msg): " &
                          Duration'Image (1000.0 * Output_Exec / (Nb_Loop - Cpt)) & " ms");
      Text_IO.Put_Line ("[Server] Output_Duration time (1 msg): " &
                          Duration'Image (1000.0 * Output_Duration / (Nb_Loop - Cpt)) & " ms");

      Sockets.Close_Socket (Socket => Listen);

      accept Wait;
      -- Text_IO.New_Line;
   exception
      when E : others =>
         Text_IO.New_Line;
         Text_IO.Put_Line ("[Server] Exception: " & Exceptions.Exception_Information (E));
         Text_IO.Put_Line (Exceptions.Exception_Message (E));
         Text_IO.Put_Line (Traceback.Symbolic.Symbolic_Traceback (E));
         if Cpt /= Nb_Loop then
            Text_IO.Put_Line ("[Server] Output_Duration time: " &
                                Duration'Image (1000.0 * Output_Duration / (Nb_Loop - Cpt)) & " ms");
         end if;
         GNAT.OS_Lib.OS_Abort;
   end Server_Thread_T;
   
begin
   Server_Thread.Start;
   Client_Thread.Start;
   Client_Thread.Synch;
   Server_Thread.Wait;
   
   Client_Thread.Wait;
   -- Text_IO.New_Line;
exception
   when E : others =>
      Text_IO.Put_Line (Exceptions.Exception_Information (E));
      Text_IO.Put_Line (Exceptions.Exception_Message (E));
      Text_IO.Put_Line (Traceback.Symbolic.Symbolic_Traceback (E));
end Test_Stream_Socket_String;

^ permalink raw reply	[relevance 6%]

* Re: Interfaces.C + generics: stack overflow
  @ 2017-03-24 22:03  3%     ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2017-03-24 22:03 UTC (permalink / raw)


On 2017-03-24 13:42, hreba wrote:

> generic
>    type Real is digits <>;
>    type Parameters is private;    -- for future use
> package GSL is
>
>    gsl_Ex:    Exception;
>    error_code:    Integer;    -- of the last operation
>
>    type Real_Function is access function (x: Real) return Real;
[...]

Your design looks wrong to me.

An important objection is that the code is not re-entrant. You store 
data in the package body during the call.

Another issue is that you forgot C convention for GSL_Function.

If you want to pass an Ada function to the integrator you must use a C 
wrapper for it. An alternative would be to use C convention for 
Real_Function, but let us put that aside.

Now the Params component is just for this case. What you should do is to 
pass a pointer to the Ada function via Params plus parameter for the 
function if any. E.g.

    type Arguments is record
       Func   : Real_Function;
       Params : Parameters; -- You can use parameters later
    end record;
    type Arguments_Ptr is access all Arguments;
    pragma Convention (C, Arguments_Ptr);

    type GSL_Inner_Function is
       access function
              (  x      : C.double;
                 params : Arguments_Ptr
              )  return C.double;
    pragma Convention (C, GSL_Inner_Function);

    type GSL_Function is record
       func   : GSL_Inner_Function;
       params : Arguments_Ptr;
    end record;
    pragma Convention (C, GSL_Function); -- Do not forget this!

    function C_Func (X : C.double; Params : Arguments_Ptr)
       return C.double;
    pragma Convention (C, C_Func);

    function C_Func (X : C.double; Params : Arguments_Ptr)
       return C.double is
    begin -- Params is pointer to Ada function + its parameters
       return C.double (Params.Func (Real (x)));
    exception
       when others => -- You never propagate Ada exceptions from C
          return 0.0; -- code! Do tracing here if you want or call
    end C_Func;       -- Exit() to kill the program

    function gsl_integration_qng
             ( f                    : in out GSL_Function;
               a, b, epsabs, epsrel : C.double;
               result, abserr       : out C.double;
               neval                : out C.size_t
             ) return C.int;
    pragma Import (C, gsl_integration_qng, "gsl_integration_qng");

    procedure Integration_QNG
              (  f                    : Real_Function;
                 a, b, epsabs, epsrel : Real;
                 result, abserr       : out Real;
                 neval                : out Natural
              )  is
       use type C.int;
       Ada_Data : aliased Arguments;
       C_Data   : GSL_Function :=
                     (C_Func'Access, Ada_Data'Unchecked_Access);
       status   : C.int;
       res, ae  : C.double;
       ne       : C.size_t;
    begin
       Ada_Data.Func := f;
       status :=
          gsl_integration_qng
          (  C_Data,
             C.double (a),
             C.double (b),
             C.double (epsabs),
             C.double (epsrel),
             res, ae, ne
          );
    ...

No data stored in the package body.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de


^ permalink raw reply	[relevance 3%]

* Re: State of the compiler market
  @ 2017-02-25 13:46  5%     ` G.B.
  0 siblings, 0 replies; 200+ results
From: G.B. @ 2017-02-25 13:46 UTC (permalink / raw)


On 25/02/2017 12:29, Dmitry A. Kazakov wrote:
> 3. Ada parser is the least problem, so minor that there is nothing to talk about. It is a matter of a pair days to work out.

For example, importing a C function, or calling an Ada
function that is known to use setjmp/longjmp,
how can the Ada compiler optimize use of local variables passed
to that function by reference, or by copy, in the presence of
Ada exceptions?

How do other advertised languages tackle these situations?
I guess that there is the usual rhetorical appeal, such as
to "pragmatism". "We have never heard of such problems."
"Talk to our service representative to see if we can
find a solution for you." $...

^ permalink raw reply	[relevance 5%]

* Re: Experimenting with the OOP features in Ada
  2017-01-02 13:21  5% Experimenting with the OOP features in Ada Laurent
@ 2017-01-02 16:41  0% ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2017-01-02 16:41 UTC (permalink / raw)


On 2017-01-02 14:21, Laurent wrote:

> Trying some OOP features in Ada. So not sure if everything is actually
> correct.
> Comments are welcome.
>
> So I have done a little test. Link at the end.
> I get the following error:
>
> raised CONSTRAINT_ERROR : my_strings-handle.adb:14 access check failed
>
> Which I don't understand. Sounds like the object no longer exists?
>
> test.adb:
>
> with Ada.Text_IO;
> with Ada.Exceptions;
>
> with Gnat.Traceback.Symbolic; use Gnat;
>
> with Base_Types.Antibiotics;
> with My_Strings;
> with My_Strings.Handle;
>
> procedure Test is
>
>    package SS renames My_Strings.Handle;
>
>    Test_Antibiotic : Base_Types.Antibiotics.Object
> :=Base_Types.Antibiotics.Create (Name     => "Test Antibiotic 1",
>    Code_SIL =>"123",
>    CMI      => "1",
>    SIR      => "S");
>
>    Test_String     : My_Strings.Handle.My_Safe_String := SS.Create ("Test
> single 1");
>
> begin
>
>    Ada.Text_IO.Put_Line (Test_String.Value);
>    Test_String := SS.Create ("Test single 2");
>    Ada.Text_IO.Put_Line (Test_String.Value);
>    Test_String := SS.Create ("Test single 3");
>    Ada.Text_IO.Put_Line (Test_String.Value);
>    Ada.Text_IO.Put_Line (Test_String.Value);
>    Ada.Text_IO.New_Line;
>
>    Ada.Text_IO.Put_Line ("Test record run 1:");
>    Ada.Text_IO.New_Line;
>
>    Ada.Text_IO.Put_Line ("Name: " & Test_Antibiotic.Name_Value);
>    Ada.Text_IO.Put_Line ("Code SIL: " & Test_Antibiotic.Code_SIL_Value);
>    Ada.Text_IO.Put_Line ("CMI: " & Test_Antibiotic.CMI_Value);
>    Ada.Text_IO.Put_Line ("SIR: " & Test_Antibiotic.SIR_Value);
>    Ada.Text_IO.New_Line;
>
>    Ada.Text_IO.Put_Line ("Test record run 2:");
>    Ada.Text_IO.New_Line;
>
>    Test_Antibiotic := Base_Types.Antibiotics.Create_Name (Name => "Test
> Antibiotic 2");
>    Ada.Text_IO.Put_Line ("Name: " & Test_Antibiotic.Name_Value);
>
>    Test_Antibiotic := Base_Types.Antibiotics.Create_Code_SIL (Code_SIL =>
> "amc");
>    Ada.Text_IO.Put_Line ("Code SIL: " & Test_Antibiotic.Code_SIL_Value);
>
>    Test_Antibiotic := Base_Types.Antibiotics.Create_CMI (CMI => "2");
>    Ada.Text_IO.Put_Line ("CMI: " & Test_Antibiotic.CMI_Value);
>
>    Test_Antibiotic := Base_Types.Antibiotics.Create_SIR (SIR => "R");
>    Ada.Text_IO.Put_Line ("SIR: " & Test_Antibiotic.SIR_Value);
>    Ada.Text_IO.New_Line;
>
>    Ada.Text_IO.Put_Line ("Test record run 3:");
>    Ada.Text_IO.New_Line;
>
>    Test_Antibiotic := Base_Types.Antibiotics.Create_Name (Name => "Test
> Antibiotic 3");
>    Test_Antibiotic := Base_Types.Antibiotics.Create_Code_SIL (Code_SIL =>
> "gen");
>    Test_Antibiotic := Base_Types.Antibiotics.Create_CMI (CMI => "8");
>    Test_Antibiotic := Base_Types.Antibiotics.Create_SIR (SIR => "I");
>
>    Ada.Text_IO.Put_Line ("Print run 3:");
>
>    Ada.Text_IO.Put_Line ("Name: " & Test_Antibiotic.Name_Value);
>    Ada.Text_IO.Put_Line ("Code SIL: " & Test_Antibiotic.Code_SIL_Value);
>    Ada.Text_IO.Put_Line ("CMI: " & Test_Antibiotic.CMI_Value);
>    Ada.Text_IO.Put_Line ("SIR: " & Test_Antibiotic.SIR_Value);
>
>    exception
>
>    when Err : others =>
>       Ada.Text_IO.Put_Line ("Problem: " &
>                               Ada.Exceptions.Exception_Information (Err));
>
>       Ada.Text_IO.Put_Line (Traceback.Symbolic.Symbolic_Traceback (Err));
>
> end Test;
>
> Terminal output:
>
> Test single 1
> Test single 2
> Test single 3
> Test single 3
>
> Test record run 1:
>
> Name: Test Antibiotic 1
> Code SIL: 123
> CMI: 1
> SIR: S
>
> Test record run 2:
>
> Name: Test Antibiotic 2
> Code SIL: amc
> CMI: 2
> SIR: R
>
> Test record run 3:
>
> Print run 3:
> Problem: raised CONSTRAINT_ERROR : my_strings-handle.adb:14 access check
> failed
>
>
> Why does it fail on the 3rd run? It works the 2 first ones?

You create a new object each time you make assignment. So at the line 42 
Create_Name creates an object with Name set. Then at the line 45 
Create_Code_SIL overwrites that object with another instance with no 
name set. When you try to get its name, the handle of the string is 
invalid. An attempt to get the value of gives Constraint_Error.

P.S. If you want to set components individually you must either expose 
them or else provide setters.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 0%]

* Experimenting with the OOP features in Ada
@ 2017-01-02 13:21  5% Laurent
  2017-01-02 16:41  0% ` Dmitry A. Kazakov
  0 siblings, 1 reply; 200+ results
From: Laurent @ 2017-01-02 13:21 UTC (permalink / raw)


Hi

Happy new year!

Trying some OOP features in Ada. So not sure if everything is actually
correct.
Comments are welcome.

So I have done a little test. Link at the end.
I get the following error:

raised CONSTRAINT_ERROR : my_strings-handle.adb:14 access check failed

Which I don't understand. Sounds like the object no longer exists?

test.adb:

with Ada.Text_IO;
with Ada.Exceptions;

with Gnat.Traceback.Symbolic; use Gnat;

with Base_Types.Antibiotics;
with My_Strings;
with My_Strings.Handle;

procedure Test is

   package SS renames My_Strings.Handle;

   Test_Antibiotic : Base_Types.Antibiotics.Object
:=Base_Types.Antibiotics.Create (Name     => "Test Antibiotic 1", 
   Code_SIL =>"123", 
   CMI      => "1", 
   SIR      => "S");
   
   Test_String     : My_Strings.Handle.My_Safe_String := SS.Create ("Test
single 1");
   
begin

   Ada.Text_IO.Put_Line (Test_String.Value);
   Test_String := SS.Create ("Test single 2");
   Ada.Text_IO.Put_Line (Test_String.Value);
   Test_String := SS.Create ("Test single 3");
   Ada.Text_IO.Put_Line (Test_String.Value);
   Ada.Text_IO.Put_Line (Test_String.Value);
   Ada.Text_IO.New_Line;

   Ada.Text_IO.Put_Line ("Test record run 1:");
   Ada.Text_IO.New_Line;

   Ada.Text_IO.Put_Line ("Name: " & Test_Antibiotic.Name_Value);
   Ada.Text_IO.Put_Line ("Code SIL: " & Test_Antibiotic.Code_SIL_Value);
   Ada.Text_IO.Put_Line ("CMI: " & Test_Antibiotic.CMI_Value);
   Ada.Text_IO.Put_Line ("SIR: " & Test_Antibiotic.SIR_Value);
   Ada.Text_IO.New_Line;
   
   Ada.Text_IO.Put_Line ("Test record run 2:");
   Ada.Text_IO.New_Line;
   
   Test_Antibiotic := Base_Types.Antibiotics.Create_Name (Name => "Test
Antibiotic 2");
   Ada.Text_IO.Put_Line ("Name: " & Test_Antibiotic.Name_Value);

   Test_Antibiotic := Base_Types.Antibiotics.Create_Code_SIL (Code_SIL =>
"amc");
   Ada.Text_IO.Put_Line ("Code SIL: " & Test_Antibiotic.Code_SIL_Value);

   Test_Antibiotic := Base_Types.Antibiotics.Create_CMI (CMI => "2");
   Ada.Text_IO.Put_Line ("CMI: " & Test_Antibiotic.CMI_Value);      
      
   Test_Antibiotic := Base_Types.Antibiotics.Create_SIR (SIR => "R");
   Ada.Text_IO.Put_Line ("SIR: " & Test_Antibiotic.SIR_Value);
   Ada.Text_IO.New_Line;
   
   Ada.Text_IO.Put_Line ("Test record run 3:");
   Ada.Text_IO.New_Line;

   Test_Antibiotic := Base_Types.Antibiotics.Create_Name (Name => "Test
Antibiotic 3");   
   Test_Antibiotic := Base_Types.Antibiotics.Create_Code_SIL (Code_SIL =>
"gen");   
   Test_Antibiotic := Base_Types.Antibiotics.Create_CMI (CMI => "8");
   Test_Antibiotic := Base_Types.Antibiotics.Create_SIR (SIR => "I");
   
   Ada.Text_IO.Put_Line ("Print run 3:");

   Ada.Text_IO.Put_Line ("Name: " & Test_Antibiotic.Name_Value);   
   Ada.Text_IO.Put_Line ("Code SIL: " & Test_Antibiotic.Code_SIL_Value);
   Ada.Text_IO.Put_Line ("CMI: " & Test_Antibiotic.CMI_Value);
   Ada.Text_IO.Put_Line ("SIR: " & Test_Antibiotic.SIR_Value);
   
   exception

   when Err : others =>
      Ada.Text_IO.Put_Line ("Problem: " &
                              Ada.Exceptions.Exception_Information (Err));

      Ada.Text_IO.Put_Line (Traceback.Symbolic.Symbolic_Traceback (Err));
   
end Test;

Terminal output:

Test single 1
Test single 2
Test single 3
Test single 3

Test record run 1:

Name: Test Antibiotic 1
Code SIL: 123
CMI: 1
SIR: S

Test record run 2:

Name: Test Antibiotic 2
Code SIL: amc
CMI: 2
SIR: R

Test record run 3:

Print run 3:
Problem: raised CONSTRAINT_ERROR : my_strings-handle.adb:14 access check
failed


Why does it fail on the 3rd run? It works the 2 first ones?

The programm depends on Dmitry A. Kazakov's Simple Components.
The My_Strings package is copied from the docs of this library.

Link to the files on Git:

https://github.com/Chutulu/BCI_2.git

Thanks

Laurent

^ permalink raw reply	[relevance 5%]

* Re: Gnat Sockets - UDP timeout too short.
  2016-10-12 14:23  5% Gnat Sockets - UDP timeout too short ahlan
@ 2016-11-04  8:48  0% ` ahlan.marriott
  0 siblings, 0 replies; 200+ results
From: ahlan.marriott @ 2016-11-04  8:48 UTC (permalink / raw)


On Wednesday, 12 October 2016 16:23:39 UTC+2, ah...@marriott.org  wrote:
> Under Microsoft Windows 8.1 (and later) Gnat.Sockets.Receive_Socket returns too early whilst waiting for a UDP datagram.
> In our test program (below) we create a UDP socket, set the timeout for one second, bind it to a port and then call receive on the socket.
> We catch and resolve the Socket_Error exception and process the expected Connection_Timed_Out.
> We note the time before issuing Receive_Socket and the time when we catch the exception and then compare the elapsed time with the receive timeout.
> On Window systems prior to Win8.1 this seems to work as expected, the elapsed time is always greater than the receive timeout.
> However under Win8.1 (and later) the call to Receive_Socket returns approximately half a second too early!
> 
> Curiously, if I write the same thing using the Win32.WinSock API then it works as expected. Which I find odd because I would have thought that Gnat.Sockets would simply be a series of wrappers around a few WinApi calls. But then what do I know?
> 
> The effect of this bug is that programs using UDP protocols timeout earlier than they should do - which often leads to curious behaviour.
> 
> We have tested this on a couple of PCs running a variety of flavours of Ms-Windows. So far it seems that XP & Win7 work as expected whereas Win8 and Win10 fail.
> 
> Has anyone any idea what might cause this problem and how we might go about fixing it?
> 
> Best wishes,
> MfG
> Ahlan
> 
> ------------------------------
> with Ada.Text_IO;
> with Ada.Exceptions;
> with Ada.Real_Time;
> with Ada.Streams;
> with GNAT.Sockets;
> 
> package body Test is
> 
>   package Io  renames Ada.Text_IO;
>   package Net renames GNAT.Sockets;
> 
>   Receive_Timeout : constant Duration := 1.0;
> 
>   Receive_Timeout_Span : constant Ada.Real_Time.Time_Span := Ada.Real_Time.To_Time_Span (Receive_Timeout);
> 
>   procedure Work is
>     The_Datagram : Ada.Streams.Stream_Element_Array (1..20);
>     The_Last     : Ada.Streams.Stream_Element_Offset;
>     The_Socket   : Net.Socket_Type;
>     Start_Time   : Ada.Real_Time.Time;
>     End_Time     : Ada.Real_Time.Time;
>     use type Ada.Real_Time.Time;
>   begin
>     Net.Create_Socket (Socket => The_Socket,
>                        Family => Net.Family_Inet,
>                        Mode   => Net.Socket_Datagram);
>     Net.Set_Socket_Option (Socket => The_Socket,
>                            Option => (Net.Receive_Timeout, Timeout => Receive_Timeout));
>     Net.Bind_Socket (The_Socket, (Family => Net.Family_Inet,
>                                   Addr   => Net.Any_Inet_Addr,
>                                   Port   => 11154));
>     loop
>       begin
>         Start_Time := Ada.Real_Time.Clock;
>         Net.Receive_Socket (Socket => The_Socket,
>                             Item   => The_Datagram,
>                             Last   => The_Last);
>         Io.New_Line;
>         Io.Put_Line ("Unexpected reply!");
>         exit;
>       exception
>       when Occurrence: Net.Socket_Error =>
>         End_Time := Ada.Real_Time.Clock;
>         declare
>           Error : constant Net.Error_Type := Net.Resolve_Exception (Occurrence);
>           use type Net.Error_Type;
>         begin
>           if Error = Net.Connection_Timed_Out then
>             if End_Time >= (Start_Time + Receive_Timeout_Span) then
>               Io.Put (".");
>             else
>               Io.New_Line;
>               declare
>                 use type Ada.Real_Time.Time_Span;
>                 Shortfall : constant Ada.Real_Time.Time_Span := Receive_Timeout_Span - (End_Time - Start_Time);
>               begin
>                 Io.Put_Line ("Timeout too short by" & Ada.Real_Time.To_Duration (Shortfall)'img & "seconds");
>               end;
>             end if;
>           else
>             Io.Put_Line ("Socket_Error : Unexpected error=" & Error'img);
>             exit;
>           end if;
>         end;
>       when Event : others =>
>         Io.Put_Line ("Unexpected exception: " & Ada.Exceptions.Exception_Name (Event));
>       end;
>     end loop;
>   exception
>   when Event : others =>
>     Io.Put_Line ("Internal Error: " & Ada.Exceptions.Exception_Name (Event));
>   end Work;
To answer my own question...
Gnat sockets uses the Winsock function Recv and sets the timeout DWORD SO_RCVTIMEO in Milliseconds.
However according to the Microsoft Developers Network in Feb 2014 (and others articles) there was an undocumented minimum limit of 500ms which seems to have been implemented by Microsoft simply adding 500ms to whatever non-zero value was placed in SO_RECVTIMEO.
The consensus workaround was simply to deduct 500ms from the desired timeout.
This is indeed what Gnat.Sockets seems to have implemented at line 2297 in g-socket.adb
if V4 > 500 then V4 := V4 - 500; elsif v4 > 0 then V4 := 1 endif;
At line 1249 in g-socket.adb the 500 is added again if the timeout is retrieved.

It seems to me that recent versions of Windows no longer adds 500ms to the Recv timeout.
This would explain why under Win8 and Win10 our receive of UDP datagrams timeout half a second too soon.

Gnat.Sockets needs to determine the version of windows and only apply the correction if necessary.

The fun of course is going to be finding our which versions of Windows need the correction and which don’t. ;-)
Win8.1 and Win10 don't, Win7 and WinXp do.
Can anyone add to this list?

Best wishes
MfG
Ahlan


^ permalink raw reply	[relevance 0%]

* Gnat Sockets - UDP timeout too short.
@ 2016-10-12 14:23  5% ahlan
  2016-11-04  8:48  0% ` ahlan.marriott
  0 siblings, 1 reply; 200+ results
From: ahlan @ 2016-10-12 14:23 UTC (permalink / raw)


Under Microsoft Windows 8.1 (and later) Gnat.Sockets.Receive_Socket returns too early whilst waiting for a UDP datagram.
In our test program (below) we create a UDP socket, set the timeout for one second, bind it to a port and then call receive on the socket.
We catch and resolve the Socket_Error exception and process the expected Connection_Timed_Out.
We note the time before issuing Receive_Socket and the time when we catch the exception and then compare the elapsed time with the receive timeout.
On Window systems prior to Win8.1 this seems to work as expected, the elapsed time is always greater than the receive timeout.
However under Win8.1 (and later) the call to Receive_Socket returns approximately half a second too early!

Curiously, if I write the same thing using the Win32.WinSock API then it works as expected. Which I find odd because I would have thought that Gnat.Sockets would simply be a series of wrappers around a few WinApi calls. But then what do I know?

The effect of this bug is that programs using UDP protocols timeout earlier than they should do - which often leads to curious behaviour.

We have tested this on a couple of PCs running a variety of flavours of Ms-Windows. So far it seems that XP & Win7 work as expected whereas Win8 and Win10 fail.

Has anyone any idea what might cause this problem and how we might go about fixing it?

Best wishes,
MfG
Ahlan

------------------------------
with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Real_Time;
with Ada.Streams;
with GNAT.Sockets;

package body Test is

  package Io  renames Ada.Text_IO;
  package Net renames GNAT.Sockets;

  Receive_Timeout : constant Duration := 1.0;

  Receive_Timeout_Span : constant Ada.Real_Time.Time_Span := Ada.Real_Time.To_Time_Span (Receive_Timeout);

  procedure Work is
    The_Datagram : Ada.Streams.Stream_Element_Array (1..20);
    The_Last     : Ada.Streams.Stream_Element_Offset;
    The_Socket   : Net.Socket_Type;
    Start_Time   : Ada.Real_Time.Time;
    End_Time     : Ada.Real_Time.Time;
    use type Ada.Real_Time.Time;
  begin
    Net.Create_Socket (Socket => The_Socket,
                       Family => Net.Family_Inet,
                       Mode   => Net.Socket_Datagram);
    Net.Set_Socket_Option (Socket => The_Socket,
                           Option => (Net.Receive_Timeout, Timeout => Receive_Timeout));
    Net.Bind_Socket (The_Socket, (Family => Net.Family_Inet,
                                  Addr   => Net.Any_Inet_Addr,
                                  Port   => 11154));
    loop
      begin
        Start_Time := Ada.Real_Time.Clock;
        Net.Receive_Socket (Socket => The_Socket,
                            Item   => The_Datagram,
                            Last   => The_Last);
        Io.New_Line;
        Io.Put_Line ("Unexpected reply!");
        exit;
      exception
      when Occurrence: Net.Socket_Error =>
        End_Time := Ada.Real_Time.Clock;
        declare
          Error : constant Net.Error_Type := Net.Resolve_Exception (Occurrence);
          use type Net.Error_Type;
        begin
          if Error = Net.Connection_Timed_Out then
            if End_Time >= (Start_Time + Receive_Timeout_Span) then
              Io.Put (".");
            else
              Io.New_Line;
              declare
                use type Ada.Real_Time.Time_Span;
                Shortfall : constant Ada.Real_Time.Time_Span := Receive_Timeout_Span - (End_Time - Start_Time);
              begin
                Io.Put_Line ("Timeout too short by" & Ada.Real_Time.To_Duration (Shortfall)'img & "seconds");
              end;
            end if;
          else
            Io.Put_Line ("Socket_Error : Unexpected error=" & Error'img);
            exit;
          end if;
        end;
      when Event : others =>
        Io.Put_Line ("Unexpected exception: " & Ada.Exceptions.Exception_Name (Event));
      end;
    end loop;
  exception
  when Event : others =>
    Io.Put_Line ("Internal Error: " & Ada.Exceptions.Exception_Name (Event));
  end Work;


^ permalink raw reply	[relevance 5%]

* Re: Can anyone help with GNAT.Perfect_Hash_Generators ? (Possible memory corruption)
  2016-09-06 21:04  6%       ` Simon Wright
@ 2016-09-08 16:00  0%         ` Anh Vo
  0 siblings, 0 replies; 200+ results
From: Anh Vo @ 2016-09-08 16:00 UTC (permalink / raw)


On Tuesday, September 6, 2016 at 2:04:43 PM UTC-7, Simon Wright wrote:
> Florian Weimer <fw@deneb.enyo.de> writes:
> 
> > * Natasha Kerensikova:
> 
> (BTW, phg4 failed badly with "too many tries" or some such)
> 
> >> So at this my conclusion is that GNAT.Perfect_Hash_Generators somehow
> >> works fine with 1-based string, but has trouble dealing with strings
> >> with larger indices.
> >
> > Yes, that's reasonable to assume.  It's a relatively common source of
> > bugs in Ada library code.
> >
> > One way to pin-point this further is to makea copy of the
> > g-pehage.ads, g-pehage.adb files, rename the package, and compile it
> > as part of your project, so that the usual Ada checks aren't
> > eliminated.
> 
> Yes. With phg2, under gdb, macOS, GNAT GPL 2016,
> 
> Catchpoint 1, CONSTRAINT_ERROR (perfect_hash_generators.adb:2268 index check failed) at 0x000000010000e03e in perfect_hash_generators.select_char_position.count_different_keys (
>     table=..., last=1, pos=1) at perfect_hash_generators.adb:2268
> 2268	               C := WT.Table (Reduced (K))(Pos);
> (gdb) l
> 2263	
> 2264	            --  Count the occurrences of the different characters
> 2265	
> 2266	            N := (others => 0);
> 2267	            for K in Table (S).First .. Table (S).Last loop
> 2268	               C := WT.Table (Reduced (K))(Pos);
> 2269	               N (C) := N (C) + 1;
> 2270	            end loop;
> 2271	
> 2272	            --  Update the number of different keys. Each character used
> (gdb) bt
> #0  <__gnat_debug_raise_exception> (e=0x100059440, message=...) at s-excdeb.adb:43
> #1  0x0000000100019e8c in ada.exceptions.complete_occurrence (x=0x100500af0)
>     at a-except.adb:925
> #2  0x0000000100019e9b in ada.exceptions.complete_and_propagate_occurrence (
>     x=0x100500af0) at a-except.adb:936
> #3  0x000000010001a2a6 in ada.exceptions.raise_with_location_and_msg (e=0x100059440, 
>     f=(system.address) 0x10003ca64, l=2268, c=0, m=(system.address) 0x10003e640)
>     at a-except.adb:1162
> #4  0x0000000100019e61 in <__gnat_raise_constraint_error_msg> (file=<optimized out>, 
>     line=<optimized out>, column=<optimized out>, msg=<optimized out>)
>     at a-except.adb:891
> #5  0x000000010001a390 in <__gnat_rcheck_CE_Index_Check> (file=<optimized out>, 
>     line=<optimized out>) at a-except.adb:1237
> #6  0x000000010000e03e in perfect_hash_generators.select_char_position.count_different_keys (table=..., last=1, pos=1) at perfect_hash_generators.adb:2268
> #7  0x000000010000ca72 in perfect_hash_generators.select_char_position ()
>     at perfect_hash_generators.adb:2326
> #8  0x000000010000354b in perfect_hash_generators.compute (position=...)
>     at perfect_hash_generators.adb:685
> #9  0x000000010000f466 in phg2 () at phg2.adb:52
> (gdb) p k
> $1 = 67
> (gdb) p pos
> $2 = 1
> (gdb) p reduced(k)
> $3 = 322
> (gdb) p table(s)
> $4 = (first => 0, last => 253)
> 
> ... gdb doesn't know what WT.Table is ... it's in an instantiation of
> gnat.table ..
> 
> 
> You were right about the strings, this
> 
> with Ada.Text_IO;
> procedure Str is
>    type A is access String;
>    S : String := "xxxhelloyyy";
>    P : A;
> begin
>    P := new String'(S (4 .. 8));
>    Ada.Text_IO.Put_Line
>      ("""" & P.all & """ has indices"
>         & P.all'First'Img & " .." & P.all'Last'Img);
> end Str;
> 
> gives
> 
> $ ./str
> "hello" has indices 4 .. 8

Then, what would be the proper fix?


^ permalink raw reply	[relevance 0%]

* Re: Can anyone help with GNAT.Perfect_Hash_Generators ? (Possible memory corruption)
  @ 2016-09-06 21:04  6%       ` Simon Wright
  2016-09-08 16:00  0%         ` Anh Vo
  0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2016-09-06 21:04 UTC (permalink / raw)


Florian Weimer <fw@deneb.enyo.de> writes:

> * Natasha Kerensikova:

(BTW, phg4 failed badly with "too many tries" or some such)

>> So at this my conclusion is that GNAT.Perfect_Hash_Generators somehow
>> works fine with 1-based string, but has trouble dealing with strings
>> with larger indices.
>
> Yes, that's reasonable to assume.  It's a relatively common source of
> bugs in Ada library code.
>
> One way to pin-point this further is to makea copy of the
> g-pehage.ads, g-pehage.adb files, rename the package, and compile it
> as part of your project, so that the usual Ada checks aren't
> eliminated.

Yes. With phg2, under gdb, macOS, GNAT GPL 2016,

Catchpoint 1, CONSTRAINT_ERROR (perfect_hash_generators.adb:2268 index check failed) at 0x000000010000e03e in perfect_hash_generators.select_char_position.count_different_keys (
    table=..., last=1, pos=1) at perfect_hash_generators.adb:2268
2268	               C := WT.Table (Reduced (K))(Pos);
(gdb) l
2263	
2264	            --  Count the occurrences of the different characters
2265	
2266	            N := (others => 0);
2267	            for K in Table (S).First .. Table (S).Last loop
2268	               C := WT.Table (Reduced (K))(Pos);
2269	               N (C) := N (C) + 1;
2270	            end loop;
2271	
2272	            --  Update the number of different keys. Each character used
(gdb) bt
#0  <__gnat_debug_raise_exception> (e=0x100059440, message=...) at s-excdeb.adb:43
#1  0x0000000100019e8c in ada.exceptions.complete_occurrence (x=0x100500af0)
    at a-except.adb:925
#2  0x0000000100019e9b in ada.exceptions.complete_and_propagate_occurrence (
    x=0x100500af0) at a-except.adb:936
#3  0x000000010001a2a6 in ada.exceptions.raise_with_location_and_msg (e=0x100059440, 
    f=(system.address) 0x10003ca64, l=2268, c=0, m=(system.address) 0x10003e640)
    at a-except.adb:1162
#4  0x0000000100019e61 in <__gnat_raise_constraint_error_msg> (file=<optimized out>, 
    line=<optimized out>, column=<optimized out>, msg=<optimized out>)
    at a-except.adb:891
#5  0x000000010001a390 in <__gnat_rcheck_CE_Index_Check> (file=<optimized out>, 
    line=<optimized out>) at a-except.adb:1237
#6  0x000000010000e03e in perfect_hash_generators.select_char_position.count_different_keys (table=..., last=1, pos=1) at perfect_hash_generators.adb:2268
#7  0x000000010000ca72 in perfect_hash_generators.select_char_position ()
    at perfect_hash_generators.adb:2326
#8  0x000000010000354b in perfect_hash_generators.compute (position=...)
    at perfect_hash_generators.adb:685
#9  0x000000010000f466 in phg2 () at phg2.adb:52
(gdb) p k
$1 = 67
(gdb) p pos
$2 = 1
(gdb) p reduced(k)
$3 = 322
(gdb) p table(s)
$4 = (first => 0, last => 253)

... gdb doesn't know what WT.Table is ... it's in an instantiation of
gnat.table ..


You were right about the strings, this

with Ada.Text_IO;
procedure Str is
   type A is access String;
   S : String := "xxxhelloyyy";
   P : A;
begin
   P := new String'(S (4 .. 8));
   Ada.Text_IO.Put_Line
     ("""" & P.all & """ has indices"
        & P.all'First'Img & " .." & P.all'Last'Img);
end Str;

gives

$ ./str
"hello" has indices 4 .. 8


^ permalink raw reply	[relevance 6%]

* Re: Exception traceback when using TDM-GCC 5.1.0-3
  2016-07-29 18:48  0%                                                 ` Anh Vo
@ 2016-07-30  8:11  0%                                                   ` ahlan.marriott
  0 siblings, 0 replies; 200+ results
From: ahlan.marriott @ 2016-07-30  8:11 UTC (permalink / raw)


On Friday, 29 July 2016 20:48:54 UTC+2, Anh Vo  wrote:
> On Friday, July 29, 2016 at 8:57:44 AM UTC-7, Anh Vo wrote:
> > On Thursday, July 28, 2016 at 1:34:12 PM UTC-7, ahlan.m...@gmail.com wrote:
> > > On Thursday, 28 July 2016 18:16:14 UTC+2, Anh Vo  wrote:
> > > > On Thursday, July 28, 2016 at 9:00:16 AM UTC-7, ahlan.m...@gmail.com wrote:
> > > > > On Thursday, 28 July 2016 17:44:32 UTC+2, Anh Vo  wrote:
> > > > > > On Thursday, July 28, 2016 at 7:48:17 AM UTC-7, Anh Vo wrote:
> > > > > > > On Wednesday, July 27, 2016 at 11:07:02 PM UTC-7, ahlan.m...@gmail.com wrote:
> > > > > > > > >  
> > > > > > > > > The exception is captured captured and handled in the exception handler. In addition, the traceback information is extracted as shown below.
> > > > > > > > > 
> > > > > > > > > --...
> > > > > > > > > exception 
> > > > > > > > >    when Error : others =>      
> > > > > > > > >      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > > > > > > > --...
> > > > > > > > 
> > > > > > > > Dear Anh,
> > > > > > > > 
> > > > > > > > Yes this is how I catch exceptions and display them symbolically.
> > > > > > > > My current problem is that although I get some kind of traceback, it isn't complete.
> > > > > > > > I only get two of the expected eight traceback addresses.
> > > > > > > > The two I do get have very high addresses and it seems normal that these
> > > > > > > > cannot be resolved symbolically - hence they are displayed as "??" by both
> > > > > > > > Gnat.Traceback.Symbolic.Symbolic_Traceback and addr2line
> > > > > > > 
> > > > > > > Try Simon's code with my modification shown below to see what I get complete traceback. By the way, it work on my PC.
> > > > > > > 
> > > > > > > with Ada.Exceptions;  use Ada.Exceptions;
> > > > > > > with Ada.Text_Io; use Ada.Text_Io;
> > > > > > > with GNAT.Traceback.Symbolic;
> > > > > > > procedure CE is
> > > > > > >    procedure Raiser (N : Positive) is
> > > > > > >    begin
> > > > > > >       Raiser (N - 1);
> > > > > > >    end Raiser;
> > > > > > > begin
> > > > > > >    Raiser (5);
> > > > > > > exception
> > > > > > >    when Error : others =>
> > > > > > >       Put_Line ("Houston we have a problem: " & Exception_Information(Error));
> > > > > > >       Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > > > > > end Ce; 
> > > > > > > 
> > > > > > > AV
> > > > > > 
> > > > > > Sorry, what I meant was "Try Simon's code with my modification shown below to see if you get complete traceback. By the way, it worked on my PC."
> > > > > 
> > > > > Dear Anh,
> > > > > 
> > > > > Yes I appreciate that..
> > > > > This is what I always try to do - and it works with GPL but not with TDM.
> > > > > But then nor does Addr2line so something is not quite right.
> > > >  
> > > > I share your frustration since I was in a similar situation before. Thus, I have a suggestion. Use a PC having no GNAT nor TDM-GCC installed before. Install TDM-GCC and try it one more time. By the way, use command line "gnatmake -f -g ce.adb -bargs -E" first. If you do not have another PC, uninstall GNAT-GPL and TDM-GCC completely before reinstall TDM-GCC.
> > > > 
> > > > Anh Vo
> > > 
> > > Dear Anh,
> > > Although it made no real sense, I did as you suggested and much to my surprise I now get a traceback when I use gnatmake that when fed to Addr2line returns the traceback that Simon has. 
> > > i.e. Address within CE.adb
> > > At least this is useful.
> > > However trying to convert this into a symbolic traceback using GNAT.Traceback.Symbolic.Symbolic_Traceback(Error)
> > > merely produces eight lines of output - each line with the hexadecimal traceback address.
> > > i.e. GNAT.Traceback.Symbolic.Symbolic_Traceback isn't working.
> > > Does it work for you?
> > 
> > Yes, it does work as expected. Here are the results I got.
> > 
> > Houston we have a problem: Exception name: CONSTRAINT_ERROR
> > Message: ce.adb:7 range check failed
> > Call stack traceback locations:
> > 0x40198b 0x40199b 0x40199b 0x40199b 0x40199b 0x4019bb 0x40194f 0x4013db 0x75883388 0x77949900 0x779498d3
> > 
> > [C:\Ada\Test\ce.exe]
> > 0x0040198B ce.raiser at ce.adb:7
> > 0x0040199B ce.raiser at ce.adb:7
> > 0x0040199B ce.raiser at ce.adb:7
> > 0x0040199B ce.raiser at ce.adb:7
> > 0x0040199B ce.raiser at ce.adb:7
> > 0x004019BB ce at ce.adb:10
> > 0x0040194F main at b~ce.adb:221
> > 0x004013DB .tmainCRTStartup at crtexe.c:332
> > 
> > [C:\Windows\syswow64\kernel32.dll]
> > [C:\Windows\SysWOW64\ntdll.dll]
>  
> MIG,
> 
> My apology for crewing up. The gnatmake I invoked was part of GNAT-GPL. After correcting it on my PC at home, I got same results that you did, 9 Hex addresses without traceback location.
> 
> Anh Vo

Well at least my problem is reproducible by others.
I wonder what we are doing wrong?

MfG
Ahlan


^ permalink raw reply	[relevance 0%]

* Re: Exception traceback when using TDM-GCC 5.1.0-3
  2016-07-29 15:57  0%                                               ` Anh Vo
@ 2016-07-29 18:48  0%                                                 ` Anh Vo
  2016-07-30  8:11  0%                                                   ` ahlan.marriott
  0 siblings, 1 reply; 200+ results
From: Anh Vo @ 2016-07-29 18:48 UTC (permalink / raw)


On Friday, July 29, 2016 at 8:57:44 AM UTC-7, Anh Vo wrote:
> On Thursday, July 28, 2016 at 1:34:12 PM UTC-7, ahlan.m...@gmail.com wrote:
> > On Thursday, 28 July 2016 18:16:14 UTC+2, Anh Vo  wrote:
> > > On Thursday, July 28, 2016 at 9:00:16 AM UTC-7, ahlan.m...@gmail.com wrote:
> > > > On Thursday, 28 July 2016 17:44:32 UTC+2, Anh Vo  wrote:
> > > > > On Thursday, July 28, 2016 at 7:48:17 AM UTC-7, Anh Vo wrote:
> > > > > > On Wednesday, July 27, 2016 at 11:07:02 PM UTC-7, ahlan.m...@gmail.com wrote:
> > > > > > > >  
> > > > > > > > The exception is captured captured and handled in the exception handler. In addition, the traceback information is extracted as shown below.
> > > > > > > > 
> > > > > > > > --...
> > > > > > > > exception 
> > > > > > > >    when Error : others =>      
> > > > > > > >      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > > > > > > --...
> > > > > > > 
> > > > > > > Dear Anh,
> > > > > > > 
> > > > > > > Yes this is how I catch exceptions and display them symbolically.
> > > > > > > My current problem is that although I get some kind of traceback, it isn't complete.
> > > > > > > I only get two of the expected eight traceback addresses.
> > > > > > > The two I do get have very high addresses and it seems normal that these
> > > > > > > cannot be resolved symbolically - hence they are displayed as "??" by both
> > > > > > > Gnat.Traceback.Symbolic.Symbolic_Traceback and addr2line
> > > > > > 
> > > > > > Try Simon's code with my modification shown below to see what I get complete traceback. By the way, it work on my PC.
> > > > > > 
> > > > > > with Ada.Exceptions;  use Ada.Exceptions;
> > > > > > with Ada.Text_Io; use Ada.Text_Io;
> > > > > > with GNAT.Traceback.Symbolic;
> > > > > > procedure CE is
> > > > > >    procedure Raiser (N : Positive) is
> > > > > >    begin
> > > > > >       Raiser (N - 1);
> > > > > >    end Raiser;
> > > > > > begin
> > > > > >    Raiser (5);
> > > > > > exception
> > > > > >    when Error : others =>
> > > > > >       Put_Line ("Houston we have a problem: " & Exception_Information(Error));
> > > > > >       Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > > > > end Ce; 
> > > > > > 
> > > > > > AV
> > > > > 
> > > > > Sorry, what I meant was "Try Simon's code with my modification shown below to see if you get complete traceback. By the way, it worked on my PC."
> > > > 
> > > > Dear Anh,
> > > > 
> > > > Yes I appreciate that..
> > > > This is what I always try to do - and it works with GPL but not with TDM.
> > > > But then nor does Addr2line so something is not quite right.
> > >  
> > > I share your frustration since I was in a similar situation before. Thus, I have a suggestion. Use a PC having no GNAT nor TDM-GCC installed before. Install TDM-GCC and try it one more time. By the way, use command line "gnatmake -f -g ce.adb -bargs -E" first. If you do not have another PC, uninstall GNAT-GPL and TDM-GCC completely before reinstall TDM-GCC.
> > > 
> > > Anh Vo
> > 
> > Dear Anh,
> > Although it made no real sense, I did as you suggested and much to my surprise I now get a traceback when I use gnatmake that when fed to Addr2line returns the traceback that Simon has. 
> > i.e. Address within CE.adb
> > At least this is useful.
> > However trying to convert this into a symbolic traceback using GNAT.Traceback.Symbolic.Symbolic_Traceback(Error)
> > merely produces eight lines of output - each line with the hexadecimal traceback address.
> > i.e. GNAT.Traceback.Symbolic.Symbolic_Traceback isn't working.
> > Does it work for you?
> 
> Yes, it does work as expected. Here are the results I got.
> 
> Houston we have a problem: Exception name: CONSTRAINT_ERROR
> Message: ce.adb:7 range check failed
> Call stack traceback locations:
> 0x40198b 0x40199b 0x40199b 0x40199b 0x40199b 0x4019bb 0x40194f 0x4013db 0x75883388 0x77949900 0x779498d3
> 
> [C:\Ada\Test\ce.exe]
> 0x0040198B ce.raiser at ce.adb:7
> 0x0040199B ce.raiser at ce.adb:7
> 0x0040199B ce.raiser at ce.adb:7
> 0x0040199B ce.raiser at ce.adb:7
> 0x0040199B ce.raiser at ce.adb:7
> 0x004019BB ce at ce.adb:10
> 0x0040194F main at b~ce.adb:221
> 0x004013DB .tmainCRTStartup at crtexe.c:332
> 
> [C:\Windows\syswow64\kernel32.dll]
> [C:\Windows\SysWOW64\ntdll.dll]
 
MIG,

My apology for crewing up. The gnatmake I invoked was part of GNAT-GPL. After correcting it on my PC at home, I got same results that you did, 9 Hex addresses without traceback location.

Anh Vo


^ permalink raw reply	[relevance 0%]

* Re: Exception traceback when using TDM-GCC 5.1.0-3
  2016-07-28 20:34  0%                                             ` ahlan.marriott
@ 2016-07-29 15:57  0%                                               ` Anh Vo
  2016-07-29 18:48  0%                                                 ` Anh Vo
  0 siblings, 1 reply; 200+ results
From: Anh Vo @ 2016-07-29 15:57 UTC (permalink / raw)


On Thursday, July 28, 2016 at 1:34:12 PM UTC-7, ahlan.m...@gmail.com wrote:
> On Thursday, 28 July 2016 18:16:14 UTC+2, Anh Vo  wrote:
> > On Thursday, July 28, 2016 at 9:00:16 AM UTC-7, ahlan.m...@gmail.com wrote:
> > > On Thursday, 28 July 2016 17:44:32 UTC+2, Anh Vo  wrote:
> > > > On Thursday, July 28, 2016 at 7:48:17 AM UTC-7, Anh Vo wrote:
> > > > > On Wednesday, July 27, 2016 at 11:07:02 PM UTC-7, ahlan.m...@gmail.com wrote:
> > > > > > >  
> > > > > > > The exception is captured captured and handled in the exception handler. In addition, the traceback information is extracted as shown below.
> > > > > > > 
> > > > > > > --...
> > > > > > > exception 
> > > > > > >    when Error : others =>      
> > > > > > >      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > > > > > --...
> > > > > > 
> > > > > > Dear Anh,
> > > > > > 
> > > > > > Yes this is how I catch exceptions and display them symbolically.
> > > > > > My current problem is that although I get some kind of traceback, it isn't complete.
> > > > > > I only get two of the expected eight traceback addresses.
> > > > > > The two I do get have very high addresses and it seems normal that these
> > > > > > cannot be resolved symbolically - hence they are displayed as "??" by both
> > > > > > Gnat.Traceback.Symbolic.Symbolic_Traceback and addr2line
> > > > > 
> > > > > Try Simon's code with my modification shown below to see what I get complete traceback. By the way, it work on my PC.
> > > > > 
> > > > > with Ada.Exceptions;  use Ada.Exceptions;
> > > > > with Ada.Text_Io; use Ada.Text_Io;
> > > > > with GNAT.Traceback.Symbolic;
> > > > > procedure CE is
> > > > >    procedure Raiser (N : Positive) is
> > > > >    begin
> > > > >       Raiser (N - 1);
> > > > >    end Raiser;
> > > > > begin
> > > > >    Raiser (5);
> > > > > exception
> > > > >    when Error : others =>
> > > > >       Put_Line ("Houston we have a problem: " & Exception_Information(Error));
> > > > >       Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > > > end Ce; 
> > > > > 
> > > > > AV
> > > > 
> > > > Sorry, what I meant was "Try Simon's code with my modification shown below to see if you get complete traceback. By the way, it worked on my PC."
> > > 
> > > Dear Anh,
> > > 
> > > Yes I appreciate that..
> > > This is what I always try to do - and it works with GPL but not with TDM.
> > > But then nor does Addr2line so something is not quite right.
> >  
> > I share your frustration since I was in a similar situation before. Thus, I have a suggestion. Use a PC having no GNAT nor TDM-GCC installed before. Install TDM-GCC and try it one more time. By the way, use command line "gnatmake -f -g ce.adb -bargs -E" first. If you do not have another PC, uninstall GNAT-GPL and TDM-GCC completely before reinstall TDM-GCC.
> > 
> > Anh Vo
> 
> Dear Anh,
> Although it made no real sense, I did as you suggested and much to my surprise I now get a traceback when I use gnatmake that when fed to Addr2line returns the traceback that Simon has. 
> i.e. Address within CE.adb
> At least this is useful.
> However trying to convert this into a symbolic traceback using GNAT.Traceback.Symbolic.Symbolic_Traceback(Error)
> merely produces eight lines of output - each line with the hexadecimal traceback address.
> i.e. GNAT.Traceback.Symbolic.Symbolic_Traceback isn't working.
> Does it work for you?

Yes, it does work as expected. Here are the results I got.

Houston we have a problem: Exception name: CONSTRAINT_ERROR
Message: ce.adb:7 range check failed
Call stack traceback locations:
0x40198b 0x40199b 0x40199b 0x40199b 0x40199b 0x4019bb 0x40194f 0x4013db 0x75883388 0x77949900 0x779498d3

[C:\Ada\Test\ce.exe]
0x0040198B ce.raiser at ce.adb:7
0x0040199B ce.raiser at ce.adb:7
0x0040199B ce.raiser at ce.adb:7
0x0040199B ce.raiser at ce.adb:7
0x0040199B ce.raiser at ce.adb:7
0x004019BB ce at ce.adb:10
0x0040194F main at b~ce.adb:221
0x004013DB .tmainCRTStartup at crtexe.c:332

[C:\Windows\syswow64\kernel32.dll]
[C:\Windows\SysWOW64\ntdll.dll]

Anh Vo


^ permalink raw reply	[relevance 0%]

* Re: Exception traceback when using TDM-GCC 5.1.0-3
  2016-07-28 16:16  0%                                           ` Anh Vo
@ 2016-07-28 20:34  0%                                             ` ahlan.marriott
  2016-07-29 15:57  0%                                               ` Anh Vo
  0 siblings, 1 reply; 200+ results
From: ahlan.marriott @ 2016-07-28 20:34 UTC (permalink / raw)


On Thursday, 28 July 2016 18:16:14 UTC+2, Anh Vo  wrote:
> On Thursday, July 28, 2016 at 9:00:16 AM UTC-7, ahlan.m...@gmail.com wrote:
> > On Thursday, 28 July 2016 17:44:32 UTC+2, Anh Vo  wrote:
> > > On Thursday, July 28, 2016 at 7:48:17 AM UTC-7, Anh Vo wrote:
> > > > On Wednesday, July 27, 2016 at 11:07:02 PM UTC-7, ahlan.m...@gmail.com wrote:
> > > > > >  
> > > > > > The exception is captured captured and handled in the exception handler. In addition, the traceback information is extracted as shown below.
> > > > > > 
> > > > > > --...
> > > > > > exception 
> > > > > >    when Error : others =>      
> > > > > >      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > > > > --...
> > > > > 
> > > > > Dear Anh,
> > > > > 
> > > > > Yes this is how I catch exceptions and display them symbolically.
> > > > > My current problem is that although I get some kind of traceback, it isn't complete.
> > > > > I only get two of the expected eight traceback addresses.
> > > > > The two I do get have very high addresses and it seems normal that these
> > > > > cannot be resolved symbolically - hence they are displayed as "??" by both
> > > > > Gnat.Traceback.Symbolic.Symbolic_Traceback and addr2line
> > > > 
> > > > Try Simon's code with my modification shown below to see what I get complete traceback. By the way, it work on my PC.
> > > > 
> > > > with Ada.Exceptions;  use Ada.Exceptions;
> > > > with Ada.Text_Io; use Ada.Text_Io;
> > > > with GNAT.Traceback.Symbolic;
> > > > procedure CE is
> > > >    procedure Raiser (N : Positive) is
> > > >    begin
> > > >       Raiser (N - 1);
> > > >    end Raiser;
> > > > begin
> > > >    Raiser (5);
> > > > exception
> > > >    when Error : others =>
> > > >       Put_Line ("Houston we have a problem: " & Exception_Information(Error));
> > > >       Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > > end Ce; 
> > > > 
> > > > AV
> > > 
> > > Sorry, what I meant was "Try Simon's code with my modification shown below to see if you get complete traceback. By the way, it worked on my PC."
> > 
> > Dear Anh,
> > 
> > Yes I appreciate that..
> > This is what I always try to do - and it works with GPL but not with TDM.
> > But then nor does Addr2line so something is not quite right.
>  
> I share your frustration since I was in a similar situation before. Thus, I have a suggestion. Use a PC having no GNAT nor TDM-GCC installed before. Install TDM-GCC and try it one more time. By the way, use command line "gnatmake -f -g ce.adb -bargs -E" first. If you do not have another PC, uninstall GNAT-GPL and TDM-GCC completely before reinstall TDM-GCC.
> 
> Anh Vo

Dear Anh,
Although it made no real sense, I did as you suggested and much to my surprise I now get a traceback when I use gnatmake that when fed to Addr2line returns the traceback that Simon has. 
i.e. Address within CE.adb
At least this is useful.
However trying to convert this into a symbolic traceback using GNAT.Traceback.Symbolic.Symbolic_Traceback(Error)
merely produces eight lines of output - each line with the hexadecimal traceback address.
i.e. GNAT.Traceback.Symbolic.Symbolic_Traceback isn't working.
Does it work for you?

Simon - Does GNAT.Traceback.Symbolic.Symbolic_Traceback work on your system?

Björn has a work around foo this problem - but surely this shouldn't be necessary.
Surely the whole point of GNAT.Traceback.Symbolic.Symbolic_Traceback is to save having to do what Björn does.
GNAT.Traceback.Symbolic.Symbolic_Traceback worked for me using Gnat Pro and GPL so I rather hoped it would work using TDM.

Best wishes,
Ahlan


^ permalink raw reply	[relevance 0%]

* Re: Exception traceback when using TDM-GCC 5.1.0-3
  2016-07-28 16:07  0%                                         ` ahlan.marriott
@ 2016-07-28 16:19  0%                                           ` Björn Lundin
  0 siblings, 0 replies; 200+ results
From: Björn Lundin @ 2016-07-28 16:19 UTC (permalink / raw)


On 2016-07-28 18:07, ahlan.marriott@gmail.com wrote:
> On Thursday, 28 July 2016 14:26:03 UTC+2, björn lundin  wrote:
>> On 2016-07-28 08:56, ahlan.marriott@gmail.com wrote:
>>
>>>
>>> If I do exactly what Simon does (use gnat make on a single file) then I get eight traceback addresses.
>>> However when I use addr2line I don't get a very useful symbolic traceback as it refers to lines within b~ce.adb rather than the true source ce.adb
>>> If I catch the exception and use gnat.traceback.symbolic.symbolic_traceback then all I get are the addresses and not the symbolic references I expected.
>>>
>>
>>
>> since 10 years, we are not useing
>> gnat.traceback.symbolic.symbolic_traceback.
>>
>>
>> instead we get the hex addresses with Ada.Exceptions.Exception_Message
>> and from that we use addr2line.
>>
>>
>> addr2line --functions --basenames --exe=path/to/exe-file hex-adressess
>>
>>
>> -- 
>> --
>> Björn
> 
> Dear Björn,
> 
> We use Gnat symbolic because we catch the exceptions and write them into a log.
> In this case it makes more sense to write the symbolic traceback rather than a series of hexadecimal numbers.
> With AdaCore Pro & GPL this works fine.
> If only I could get TDM to do the same ;-(
> 
> MfG
> Ahlan
> 

We spawn addr2line from the executable, feeding it the hex-adresses (and
path to exe).
We just dump that to a redirected std-out.
You could capture that output, and then put that into a log.
If you get the hex-addresses that is...







-- 
--
Björn

^ permalink raw reply	[relevance 0%]

* Re: Exception traceback when using TDM-GCC 5.1.0-3
  2016-07-28 16:00  0%                                         ` ahlan.marriott
@ 2016-07-28 16:16  0%                                           ` Anh Vo
  2016-07-28 20:34  0%                                             ` ahlan.marriott
  0 siblings, 1 reply; 200+ results
From: Anh Vo @ 2016-07-28 16:16 UTC (permalink / raw)


On Thursday, July 28, 2016 at 9:00:16 AM UTC-7, ahlan.m...@gmail.com wrote:
> On Thursday, 28 July 2016 17:44:32 UTC+2, Anh Vo  wrote:
> > On Thursday, July 28, 2016 at 7:48:17 AM UTC-7, Anh Vo wrote:
> > > On Wednesday, July 27, 2016 at 11:07:02 PM UTC-7, ahlan.m...@gmail.com wrote:
> > > > >  
> > > > > The exception is captured captured and handled in the exception handler. In addition, the traceback information is extracted as shown below.
> > > > > 
> > > > > --...
> > > > > exception 
> > > > >    when Error : others =>      
> > > > >      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > > > --...
> > > > 
> > > > Dear Anh,
> > > > 
> > > > Yes this is how I catch exceptions and display them symbolically.
> > > > My current problem is that although I get some kind of traceback, it isn't complete.
> > > > I only get two of the expected eight traceback addresses.
> > > > The two I do get have very high addresses and it seems normal that these
> > > > cannot be resolved symbolically - hence they are displayed as "??" by both
> > > > Gnat.Traceback.Symbolic.Symbolic_Traceback and addr2line
> > > 
> > > Try Simon's code with my modification shown below to see what I get complete traceback. By the way, it work on my PC.
> > > 
> > > with Ada.Exceptions;  use Ada.Exceptions;
> > > with Ada.Text_Io; use Ada.Text_Io;
> > > with GNAT.Traceback.Symbolic;
> > > procedure CE is
> > >    procedure Raiser (N : Positive) is
> > >    begin
> > >       Raiser (N - 1);
> > >    end Raiser;
> > > begin
> > >    Raiser (5);
> > > exception
> > >    when Error : others =>
> > >       Put_Line ("Houston we have a problem: " & Exception_Information(Error));
> > >       Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > end Ce; 
> > > 
> > > AV
> > 
> > Sorry, what I meant was "Try Simon's code with my modification shown below to see if you get complete traceback. By the way, it worked on my PC."
> 
> Dear Anh,
> 
> Yes I appreciate that..
> This is what I always try to do - and it works with GPL but not with TDM.
> But then nor does Addr2line so something is not quite right.
 
I share your frustration since I was in a similar situation before. Thus, I have a suggestion. Use a PC having no GNAT nor TDM-GCC installed before. Install TDM-GCC and try it one more time. By the way, use command line "gnatmake -f -g ce.adb -bargs -E" first. If you do not have another PC, uninstall GNAT-GPL and TDM-GCC completely before reinstall TDM-GCC.

Anh Vo


^ permalink raw reply	[relevance 0%]

* Re: Exception traceback when using TDM-GCC 5.1.0-3
  2016-07-28 12:26  5%                                       ` Björn Lundin
@ 2016-07-28 16:07  0%                                         ` ahlan.marriott
  2016-07-28 16:19  0%                                           ` Björn Lundin
  0 siblings, 1 reply; 200+ results
From: ahlan.marriott @ 2016-07-28 16:07 UTC (permalink / raw)


On Thursday, 28 July 2016 14:26:03 UTC+2, björn lundin  wrote:
> On 2016-07-28 08:56, ahlan.marriott@gmail.com wrote:
> 
> > 
> > If I do exactly what Simon does (use gnat make on a single file) then I get eight traceback addresses.
> > However when I use addr2line I don't get a very useful symbolic traceback as it refers to lines within b~ce.adb rather than the true source ce.adb
> > If I catch the exception and use gnat.traceback.symbolic.symbolic_traceback then all I get are the addresses and not the symbolic references I expected.
> > 
> 
> 
> since 10 years, we are not useing
> gnat.traceback.symbolic.symbolic_traceback.
> 
> 
> instead we get the hex addresses with Ada.Exceptions.Exception_Message
> and from that we use addr2line.
> 
> 
> addr2line --functions --basenames --exe=path/to/exe-file hex-adressess
> 
> 
> -- 
> --
> Björn

Dear Björn,

We use Gnat symbolic because we catch the exceptions and write them into a log.
In this case it makes more sense to write the symbolic traceback rather than a series of hexadecimal numbers.
With AdaCore Pro & GPL this works fine.
If only I could get TDM to do the same ;-(

MfG
Ahlan


^ permalink raw reply	[relevance 0%]

* Re: Exception traceback when using TDM-GCC 5.1.0-3
  2016-07-28 15:44  0%                                       ` Anh Vo
@ 2016-07-28 16:00  0%                                         ` ahlan.marriott
  2016-07-28 16:16  0%                                           ` Anh Vo
  0 siblings, 1 reply; 200+ results
From: ahlan.marriott @ 2016-07-28 16:00 UTC (permalink / raw)


On Thursday, 28 July 2016 17:44:32 UTC+2, Anh Vo  wrote:
> On Thursday, July 28, 2016 at 7:48:17 AM UTC-7, Anh Vo wrote:
> > On Wednesday, July 27, 2016 at 11:07:02 PM UTC-7, ahlan.m...@gmail.com wrote:
> > > >  
> > > > The exception is captured captured and handled in the exception handler. In addition, the traceback information is extracted as shown below.
> > > > 
> > > > --...
> > > > exception 
> > > >    when Error : others =>      
> > > >      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > > --...
> > > 
> > > Dear Anh,
> > > 
> > > Yes this is how I catch exceptions and display them symbolically.
> > > My current problem is that although I get some kind of traceback, it isn't complete.
> > > I only get two of the expected eight traceback addresses.
> > > The two I do get have very high addresses and it seems normal that these
> > > cannot be resolved symbolically - hence they are displayed as "??" by both
> > > Gnat.Traceback.Symbolic.Symbolic_Traceback and addr2line
> > 
> > Try Simon's code with my modification shown below to see what I get complete traceback. By the way, it work on my PC.
> > 
> > with Ada.Exceptions;  use Ada.Exceptions;
> > with Ada.Text_Io; use Ada.Text_Io;
> > with GNAT.Traceback.Symbolic;
> > procedure CE is
> >    procedure Raiser (N : Positive) is
> >    begin
> >       Raiser (N - 1);
> >    end Raiser;
> > begin
> >    Raiser (5);
> > exception
> >    when Error : others =>
> >       Put_Line ("Houston we have a problem: " & Exception_Information(Error));
> >       Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > end Ce; 
> > 
> > AV
> 
> Sorry, what I meant was "Try Simon's code with my modification shown below to see if you get complete traceback. By the way, it worked on my PC."

Dear Anh,

Yes I appreciate that..
This is what I always try to do - and it works with GPL but not with TDM.
But then nor does Addr2line so something is not quite right.

MfG
Ahlan


^ permalink raw reply	[relevance 0%]

* Re: Exception traceback when using TDM-GCC 5.1.0-3
  2016-07-28 14:48  6%                                     ` Anh Vo
@ 2016-07-28 15:44  0%                                       ` Anh Vo
  2016-07-28 16:00  0%                                         ` ahlan.marriott
  0 siblings, 1 reply; 200+ results
From: Anh Vo @ 2016-07-28 15:44 UTC (permalink / raw)


On Thursday, July 28, 2016 at 7:48:17 AM UTC-7, Anh Vo wrote:
> On Wednesday, July 27, 2016 at 11:07:02 PM UTC-7, ahlan.m...@gmail.com wrote:
> > >  
> > > The exception is captured captured and handled in the exception handler. In addition, the traceback information is extracted as shown below.
> > > 
> > > --...
> > > exception 
> > >    when Error : others =>      
> > >      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > > --...
> > 
> > Dear Anh,
> > 
> > Yes this is how I catch exceptions and display them symbolically.
> > My current problem is that although I get some kind of traceback, it isn't complete.
> > I only get two of the expected eight traceback addresses.
> > The two I do get have very high addresses and it seems normal that these
> > cannot be resolved symbolically - hence they are displayed as "??" by both
> > Gnat.Traceback.Symbolic.Symbolic_Traceback and addr2line
> 
> Try Simon's code with my modification shown below to see what I get complete traceback. By the way, it work on my PC.
> 
> with Ada.Exceptions;  use Ada.Exceptions;
> with Ada.Text_Io; use Ada.Text_Io;
> with GNAT.Traceback.Symbolic;
> procedure CE is
>    procedure Raiser (N : Positive) is
>    begin
>       Raiser (N - 1);
>    end Raiser;
> begin
>    Raiser (5);
> exception
>    when Error : others =>
>       Put_Line ("Houston we have a problem: " & Exception_Information(Error));
>       Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> end Ce; 
> 
> AV

Sorry, what I meant was "Try Simon's code with my modification shown below to see if you get complete traceback. By the way, it worked on my PC."

^ permalink raw reply	[relevance 0%]

* Re: Exception traceback when using TDM-GCC 5.1.0-3
    @ 2016-07-28 14:48  6%                                     ` Anh Vo
  2016-07-28 15:44  0%                                       ` Anh Vo
  1 sibling, 1 reply; 200+ results
From: Anh Vo @ 2016-07-28 14:48 UTC (permalink / raw)


On Wednesday, July 27, 2016 at 11:07:02 PM UTC-7, ahlan.m...@gmail.com wrote:
> >  
> > The exception is captured captured and handled in the exception handler. In addition, the traceback information is extracted as shown below.
> > 
> > --...
> > exception 
> >    when Error : others =>      
> >      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
> > --...
> 
> Dear Anh,
> 
> Yes this is how I catch exceptions and display them symbolically.
> My current problem is that although I get some kind of traceback, it isn't complete.
> I only get two of the expected eight traceback addresses.
> The two I do get have very high addresses and it seems normal that these
> cannot be resolved symbolically - hence they are displayed as "??" by both
> Gnat.Traceback.Symbolic.Symbolic_Traceback and addr2line

Try Simon's code with my modification shown below to see what I get complete traceback. By the way, it work on my PC.

with Ada.Exceptions;  use Ada.Exceptions;
with Ada.Text_Io; use Ada.Text_Io;
with GNAT.Traceback.Symbolic;
procedure CE is
   procedure Raiser (N : Positive) is
   begin
      Raiser (N - 1);
   end Raiser;
begin
   Raiser (5);
exception
   when Error : others =>
      Put_Line ("Houston we have a problem: " & Exception_Information(Error));
      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Error));
end Ce; 

AV


^ permalink raw reply	[relevance 6%]

* Re: Exception traceback when using TDM-GCC 5.1.0-3
  @ 2016-07-28 12:26  5%                                       ` Björn Lundin
  2016-07-28 16:07  0%                                         ` ahlan.marriott
  0 siblings, 1 reply; 200+ results
From: Björn Lundin @ 2016-07-28 12:26 UTC (permalink / raw)


On 2016-07-28 08:56, ahlan.marriott@gmail.com wrote:

> 
> If I do exactly what Simon does (use gnat make on a single file) then I get eight traceback addresses.
> However when I use addr2line I don't get a very useful symbolic traceback as it refers to lines within b~ce.adb rather than the true source ce.adb
> If I catch the exception and use gnat.traceback.symbolic.symbolic_traceback then all I get are the addresses and not the symbolic references I expected.
> 


since 10 years, we are not useing
gnat.traceback.symbolic.symbolic_traceback.


instead we get the hex addresses with Ada.Exceptions.Exception_Message
and from that we use addr2line.


addr2line --functions --basenames --exe=path/to/exe-file hex-adressess


-- 
--
Björn

^ permalink raw reply	[relevance 5%]

* Application Crashes when linked with DLL
@ 2016-07-12 19:50  5% Aurele
  0 siblings, 0 replies; 200+ results
From: Aurele @ 2016-07-12 19:50 UTC (permalink / raw)


Hi o/, I'm working with Gautier and we stumbled on an interesting program behavior and thought of sharing it with you for comments. We are using the latest version (2016) of Adacore GNAT programming studio. Here is the problem:  

Create a dynamic link library (DLL) and link it to an separate application. The application crashes with the message "This application as requested the runtime to terminate in an unusual way. Specifically, the problem is caused by the exception block in the application.  Remove it and all is well.

-- ****************************************************************** --
-- The DLL (Dynamic Link Library)
-- ****************************************************************** --
package Dll_Name is
  procedure DLL_Test_Procedure( s : Integer := 0 );
private
  pragma export( Ada, DLL_Test_Procedure, "DLL_Test_Procedure" );
end Dll_Name;

with Ada.Text_IO;
package body Dll_Name is
  procedure DLL_Test_Procedure( s : Integer := 0 ) is
    Item         : String (1 .. 80);
    Last         : Natural;
  begin
    Ada.Text_IO.Put( "Hello World from 'DLL_Test_Procedure'... : " );
    Ada.Text_IO.Put_Line( Integer'image( s ) );
    Ada.Text_IO.Get_Line( Item, Last );
  end DLL_Test_Procedure;
end Dll_Name;

-- The Import Spec (used by the application)
package Dll_Name_Imports is
  procedure DLL_Test_Procedure( s : Integer := 0 );
private
  pragma import( Ada, DLL_Test_Procedure, "DLL_Test_Procedure" );
end Dll_Name_Imports;

-- ****************************************************************** --
-- The Application
-- ****************************************************************** --
with Ada.Text_IO;
with Ada.Exceptions; use Ada.Exceptions;
with Dll_Name_Imports;
procedure Dll_Name_Tester is
  procedure Trace( s: String ) is
  begin
    Ada.Text_IO.Put_Line( Ada.Text_IO.Current_Error, s );
  end Trace;
begin
  -- Problem block (if removed everything works fine)
  declare
    Constraint_Error : exception;
  begin
    raise Constraint_Error with "Exception caught.";
  exception
    when Fail : Constraint_Error => Trace( Exception_Message ( Fail ) );
  end;
  -- 
  Dll_Name_Imports.DLL_Test_Procedure( 1955 ); -- This normally works fine
end Dll_Name_Tester;

-- ****************************************************************** --

The application (and the exception) work fine if its not linked with the DLL.

So I'm stumped !


^ permalink raw reply	[relevance 5%]

* Re: Gtkada: attach signals to menus
  @ 2016-06-19 15:02  6%     ` Stephen Leake
  0 siblings, 0 replies; 200+ results
From: Stephen Leake @ 2016-06-19 15:02 UTC (permalink / raw)


Basic menus work, but I can't figure out how to compute the submenu on the fly.

Here's my attempt:

pragma License (GPL);

with Ada.Text_IO;
with Gtk.Main;
with Gtk.Menu;
with Gtk.Menu_Bar;
with Gtk.Menu_Item;
with Gtk.Widget;
package body Menu_Demo_Pkg is

   procedure On_Window_Destroy (Widget : access Gtk.Widget.Gtk_Widget_Record'Class)
   is
      pragma Unreferenced (Widget);
   begin
      Gtk.Main.Main_Quit;
   end On_Window_Destroy;

   procedure On_Menu_Table (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class)
   is
      use Gtk.Menu_Item;
      Table_Item : constant Gtk_Menu_Item := Gtk_Menu_Item (Self);

      Menu : constant Gtk.Menu.Gtk_Menu := Gtk.Menu.Gtk_Menu_New;
      Item : Gtk_Menu_Item;
   begin
      Item := Gtk_Menu_Item_New_With_Mnemonic ("_Add");
      Menu.Append (Item);
      Item := Gtk_Menu_Item_New_With_Mnemonic ("_Edit");
      Menu.Append (Item);
      Item := Gtk_Menu_Item_New_With_Mnemonic ("_Delete");
      Menu.Append (Item);

      Table_Item.Set_Submenu (Menu);

   end On_Menu_Table;

   procedure On_Quit (Self : access Gtk.Menu_Item.Gtk_Menu_Item_Record'Class)
   is
      pragma Unreferenced (Self);
   begin
      Ada.Text_IO.Put_Line ("On_Quit");
   end On_Quit;

   function Gtk_New return Gtk.Window.Gtk_Window
   is
      use Gtk.Menu;
      use Gtk.Menu_Item;

      Main_Window : constant Gtk.Window.Gtk_Window     := Gtk.Window.Gtk_Window_New;
      Menu_Bar    : constant Gtk.Menu_Bar.Gtk_Menu_Bar := Gtk.Menu_Bar.Gtk_Menu_Bar_New;
      Menu        : constant Gtk_Menu                  := Gtk_Menu_New;
      Item        : Gtk_Menu_Item;

   begin
      Main_Window.On_Destroy (On_Window_Destroy'Access);

      Item := Gtk_Menu_Item_New_With_Mnemonic ("_Quit");
      Item.On_Activate (On_Quit'Access);
      Menu.Append (Item);

      Item := Gtk_Menu_Item_New_With_Mnemonic ("_File");
      Item.Set_Submenu (Menu);
      Menu_Bar.Append (Item);

      Item := Gtk_Menu_Item_New_With_Mnemonic ("_Table");
      --  Submenu computed in On_Menu_Table
--      Item.On_Activate (On_Menu_Table'Access);
      Item.On_Select (On_Menu_Table'Access);
      Menu_Bar.Append (Item);

      Menu_Bar.Show_All;

      Main_Window.Add (Menu_Bar);
      return Main_Window;
   end Gtk_New;
end Menu_Demo_Pkg;

pragma License (GPL);

with Gtk.Window;
package Menu_Demo_Pkg is

   function Gtk_New return Gtk.Window.Gtk_Window;

end Menu_Demo_Pkg;

pragma License (GPL);

with Ada.Exceptions;
with Ada.Text_IO;
with GNAT.Traceback.Symbolic;
with Gtk.Main;
with Gtk.Window;
with Menu_Demo_Pkg;
procedure Menu_Demo
is
   Main_Window : Gtk.Window.Gtk_Window;
begin
   Gtk.Main.Init;

   Main_Window := Menu_Demo_Pkg.Gtk_New;
   Main_Window.Show;

   Gtk.Main.Main;
exception
when E : others =>
   Ada.Text_IO.Put_Line
     ("Unhandled exception " & Ada.Exceptions.Exception_Name (E) & ": " & Ada.Exceptions.Exception_Message (E));
   Ada.Text_IO.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
end Menu_Demo;


If I use "On_Activate" for On_Menu_Table, the submenu is not shown. So I tried "On_Select"; still no submenu, and it crashes with 

(menu_demo.exe:5884): Gtk-WARNING **: GtkWindow 001915B0 is mapped but visible child GtkMenu 08B2C468 is not mapped

I know how to compute a dynamic submenu in Emacs and Win32; there must be a way to do this in Gtk.

-- Stephe

^ permalink raw reply	[relevance 6%]

* Gtkada: attach signals to menus
@ 2016-06-18 17:05  6% Stephen Leake
    0 siblings, 1 reply; 200+ results
From: Stephen Leake @ 2016-06-18 17:05 UTC (permalink / raw)


I'm using GNAT 2016 GtkAda. I'm trying to set a menu signal handler in code, but the signal handler is not called. 

I'm not using the xml ui builder, because in my full app I need to compute a submenu based on context.

Here's the code that doesn't work (pasted into Google Groups web UI, so pardon the line breaks):

pragma License (GPL);

with Ada.Text_IO;
with Gtk.Main;
with Gtk.Menu;
with Gtk.Menu_Bar;
with Gtk.Menu_Item;
with Gtk.Menu_Shell;
with Gtk.Widget;
package body Menu_Demo_Pkg is

   procedure On_Window_Destroy (Widget : access Gtk.Widget.Gtk_Widget_Record'Class)
   is
      pragma Unreferenced (Widget);
   begin
      Gtk.Main.Main_Quit;
   end On_Window_Destroy;

   procedure On_File_Menu_Activate
     (Self       : access Gtk.Menu_Shell.Gtk_Menu_Shell_Record'Class;
      Force_Hide : Boolean)
   is
      pragma Unreferenced (Force_Hide);
      pragma Unreferenced (Self);
   begin
      Ada.Text_IO.Put_Line ("On_File_Menu_Activate");
   end On_File_Menu_Activate;

   procedure On_Menu_Activate
     (Self       : access Gtk.Menu_Shell.Gtk_Menu_Shell_Record'Class;
      Force_Hide : Boolean)
   is
      pragma Unreferenced (Force_Hide);
      pragma Unreferenced (Self);
   begin
      Ada.Text_IO.Put_Line ("On_Menu_Activate");
   end On_Menu_Activate;

   function Gtk_New return Gtk.Window.Gtk_Window
   is
      use Gtk.Menu;
      use Gtk.Menu_Item;

      Main_Window : constant Gtk.Window.Gtk_Window     := Gtk.Window.Gtk_Window_New;
      Menu_Bar    : constant Gtk.Menu_Bar.Gtk_Menu_Bar := Gtk.Menu_Bar.Gtk_Menu_Bar_New;
      Menu        : constant Gtk_Menu                  := Gtk_Menu_New;
      Item        : Gtk_Menu_Item;

   begin
      Main_Window.On_Destroy (On_Window_Destroy'Access);

      Menu.Append (Gtk_Menu_Item_New_With_Mnemonic ("_Quit"));
      Item := Gtk_Menu_Item_New_With_Mnemonic ("_File");
      Item.Set_Submenu (Menu);

      Menu_Bar.Append (Item);
      Menu_Bar.Show_All;

      Menu.On_Activate_Current (On_File_Menu_Activate'Access);

      Menu_Bar.On_Activate_Current (On_Menu_Activate'Access);

      Main_Window.Add (Menu_Bar);
      return Main_Window;
   end Gtk_New;
end Menu_Demo_Pkg;

pragma License (GPL);

with Ada.Exceptions;
with Ada.Text_IO;
with GNAT.Traceback.Symbolic;
with Gtk.Main;
with Gtk.Window;
with Menu_Demo_Pkg;
procedure Menu_Demo
is
   Main_Window : Gtk.Window.Gtk_Window;
begin
   Gtk.Main.Init;

   Main_Window := Menu_Demo_Pkg.Gtk_New;
   Main_Window.Show;

   Gtk.Main.Main;
exception
when E : others =>
   Ada.Text_IO.Put_Line
     ("Unhandled exception " & Ada.Exceptions.Exception_Name (E) & ": " & Ada.Exceptions.Exception_Message (E));
   Ada.Text_IO.Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
end Menu_Demo;

When I run menu_demo, a window shows, with a menu. But when I select the menu item, no text is displayed.

How do I make this work?

-- stephe

^ permalink raw reply	[relevance 6%]

* Re: fyi, GNAT and SPARK GPL 2016 are out
  @ 2016-06-04 19:34  3%     ` Simon Wright
  0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2016-06-04 19:34 UTC (permalink / raw)


Georg Bauhaus <bauhaus@futureapps.invalid> writes:

> On 04.06.16 18:13, gautier_niouzes@hotmail.com wrote:
>> Is there an inclusion of pragma Suppress(Container_Checks) into the
>> standard on its way ? Then the remarks such as A.18.4, 69/2 could be
>> updated accordingly.
>
> Doesn't your workaround demonstrate just how the behavior
> shown by GNAT contradicts the one to expect from standards
> conformance? Or is -gnatp now overruling the effect which
>
>     Element (No_Element)
>
> is supposed to have?
>
> If this call is not the subject of some ACATS test, perhaps it
> should become one?

-gnatp means "suppress all checks". So if you were to compile your
program with this option (at least without extensive testing, or proof),
it would be on your own head if it failed.

It looks as though the Windows compiler doesn't handle access violation
(which would normally be protected by a check) usefully.

Running the test_2016 program with Container_Checks suppressed under
gdb on OS X, I get

(gdb) catch exception
Catchpoint 1: all Ada exceptions
(gdb) run
Starting program: /Users/simon/tmp/cla/test_2016 
Key not found
Key found, element= 1

Program received signal SIGSEGV, Segmentation fault.
0x0000000100008619 in test_2016.t_dic.element (container=..., key=...)
    at /opt/gnat-gpl-2016/lib/gcc/x86_64-apple-darwin14.5.0/4.9.4/adainclude/a-cohama.adb:352
352	      return Node.Element;
(gdb) bt
#0  0x0000000100008619 in test_2016.t_dic.element (container=..., key=...)
    at /opt/gnat-gpl-2016/lib/gcc/x86_64-apple-darwin14.5.0/4.9.4/adainclude/a-cohama.adb:352
#1  0x000000010000b577 in test_2016.p_ko (s=...) at test_2016.adb:22
#2  0x0000000100006127 in test_2016 () at test_2016.adb:50
(gdb) l
347	      if Checks and then Node = null then
348	         raise Constraint_Error with
349	           "no element available because key not in map";
350	      end if;
351	
352	      return Node.Element;
353	   end Element;
354	
355	   function Element (Position : Cursor) return Element_Type is
356	   begin
(gdb) c
Continuing.

Catchpoint 1, CONSTRAINT_ERROR (erroneous memory access) at 0x000000010000b577 in test_2016.p_ko (s=...) at test_2016.adb:22
22	      i:= dic.Element(To_Unbounded_String(s));

whereas with Container_Checks not suppressed I see

Starting program: /Users/simon/tmp/cla/test_2016 
Key not found
Key found, element= 1

Catchpoint 1, CONSTRAINT_ERROR (Test_2016.T_Dic.Element: no element available because key not in map) at 0x000000010000d73d in test_2016.p_ko (s=...) at test_2016.adb:22
22	      i:= dic.Element(To_Unbounded_String(s));

so in both cases I get CE.

^ permalink raw reply	[relevance 3%]

* ANN: Cortex GNAT RTS 20160522
@ 2016-05-22 14:20  3% Simon Wright
  0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2016-05-22 14:20 UTC (permalink / raw)


Available at
https://sourceforge.net/projects/cortex-gnat-rts/files/20160522/

This release includes GNAT Ada Run Time Systems (RTSs) based
on FreeRTOS (http://www.freertos.org) and targeted at boards with
Cortex-M3, -M4, -M4F MCUs (Arduino Due from http://www.arduino.org,
the STM32F4-series evaluation boards from STMicroelectronics at
http://www.st.com).

In each case, the board support for the RTS (configuration for size
and location of Flash, RAM; clock initialization; interrupt naming) is
in $RTS/adainclude. Support for the on-chip peripherals is also
included, in Ada spec files generated by SVD2Ada
(https://github.com/AdaCore/svd2ada).

The Ada source is either original or based on FSF GCC (mainly 4.9.1,
some later releases too).

(1) arduino-due is a Ravenscar-style RTOS based on FreeRTOS from
    http://www.freertos.org for the Arduino Due.

    See arduino-due/COPYING* for licensing terms.

    On-chip peripheral support in atsam3x8e/.

    Tests in test-arduino-due/.

(2) stm32f4 is a Ravenscar-style RTOS based on FreeRTOS from
    http://www.freertos.org for the STM32F4-DISC* board.

    See stm32f4/COPYING* for licensing terms.

    On-chip peripheral support in stm32f40x/.

    Tests in test-stm32f4/.

(3) stm32f429i is a Ravenscar-style RTOS based on FreeRTOS from
    http://www.freertos.org for the STM32F429I-DISC* board.

    See stm32f429i/COPYING* for licensing terms.

    On-chip peripheral support in stm32f429x/.

    Tests in test-stm32f429i/.

In this release,

* There is no longer any dependence on the STMicroelectronics'
  STM32Cube package.

* The support for on-chip peripherals is limited to the
  SVD2Ada-generated spec files. The AdaCore 'bareboard' software
  (currently https://github.com/AdaCore/bareboard, but a name change
  is under consideration) supports the STM32 line.

* Tasking no longer requires an explicit start
  (https://sourceforge.net/p/cortex-gnat-rts/tickets/5/).

* Locking in interrupt-handling protected objects no longer inhibits
  all interrupts, only those of equal or lower priority
  (https://sourceforge.net/p/cortex-gnat-rts/tickets/18/).

The standard packages included (there are more, implementation-specific,
ones) are:

Ada
Ada.Containers
Ada.Containers.Bounded_Hashed_Maps
Ada.Containers.Bounded_Vectors
Ada.Exceptions
Ada.IO_Exceptions
Ada.Interrupts
Ada.Interrupts.Names
Ada.Iterator_Interfaces
Ada.Real_Time
Ada.Streams
Ada.Synchronous_Task_Control
Ada.Tags
Ada.Task_Identification
Interfaces
Interfaces.C
Interfaces.C.Strings
System
System.Assertions
System.Address_To_Access_Conversions
System.Storage_Elements
GNAT
GNAT.Source_Info


^ permalink raw reply	[relevance 3%]

* Re: Building an encapsulated library that uses GNAT sockets under Windows
  2016-04-22  8:23  0%   ` Dmitry A. Kazakov
@ 2016-04-23  9:20  0%     ` Ahlan
  0 siblings, 0 replies; 200+ results
From: Ahlan @ 2016-04-23  9:20 UTC (permalink / raw)


On Friday, 22 April 2016 10:23:31 UTC+2, Dmitry A. Kazakov  wrote:
> On 22/04/2016 09:58, ahlan@marriott.org wrote:
> > On Thursday, 21 April 2016 15:00:04 UTC+2, Dmitry A. Kazakov  wrote:
> >> It seems I finally found a way to build it. The solution is quite
> >> perplexing. I would be glad if anybody could shed some light on it.
> >>
> >> An encapsulated library requires that -lws2_32 -lwsock32 appeared *both*
> >> at the beginning and the end of the linker command line. Only then no
> >> "undefined reference" messages appear.
> >>
> >> For this build this program:
> >> --------------------------------------- gcc_wrapper.adb ---
> >> with Ada.Command_Line;  use Ada.Command_Line;
> >> with Ada.Exceptions;    use Ada.Exceptions;
> >> with Ada.Text_IO;       use Ada.Text_IO;
> >> with GNAT.OS_Lib;       use GNAT.OS_Lib;
> >>
> >> procedure GCC_Wrapper is
> >>      Prefix : String_List :=
> >>               (  new String'("-lwsock32"),
> >>                  new String'("-lws2_32")
> >>               );
> >>      Options : String_List (1..Argument_Count);
> >> begin
> >>      for No in 1..Argument_Count loop
> >>         Options (No) := new String'(Argument (No));
> >>      end loop;
> >>      declare
> >>         List : String_List := Prefix & Options & Prefix;
> >>      begin
> >>         Put ("gcc.exe");
> >>         for No in List'Range loop
> >>            Put (" " & List (No).all);
> >>         end loop;
> >>         New_Line;
> >>         Set_Exit_Status (Exit_Status (Spawn ("gcc.exe", List)));
> >>      end;
> >> exception
> >>      when Error : others =>
> >>         Put_Line
> >>         (  Standard_Error,
> >>            "Fault: " & Exception_Information (Error)
> >>         );
> >>         Set_Exit_Status (2);
> >> end GCC_Wrapper;
> >> --------------------------------------- gcc_wrapper.adb ---
> >>
> >> The project file must contain:
> >>
> >>      package Linker is
> >>         for Driver use "<absolute-path-to>/gcc_wrapper.exe";
> >>      end Linker;
> >>
> >> --
> >> Regards,
> >> Dmitry A. Kazakov
> >> http://www.dmitry-kazakov.de
> >
> > Dear Dmitry,
> >
> > Is this perhaps the solution to my question "Using Gnat.Sockets in a Windows DLL" that I posted on 8-Dec-2015?
> 
> Yes, I think it is the same problem you reported. BTW, I built gprbuild 
> from the latest Git sources. That did not fix the problem.
> 
> It looks really weird how GCC linker searches libraries under Windows. 
> Not to mention its abysmal performance. It takes literally an hour to 
> link an executable against 20-30 libraries.
> 
> -- 
> Regards,
> Dmitry A. Kazakov
> http://www.dmitry-kazakov.de

Dear Dmitry,
The problem is not in Gprbuild.exe but in libexe/gprbuild/gprlib.exe
Have you tried building Gprlib from the git sources? - that might be a more elegant solution.

MfG
Ahlan

^ permalink raw reply	[relevance 0%]

* Re: Building an encapsulated library that uses GNAT sockets under Windows
  2016-04-22  7:58  0% ` ahlan.marriott
@ 2016-04-22  8:23  0%   ` Dmitry A. Kazakov
  2016-04-23  9:20  0%     ` Ahlan
  0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2016-04-22  8:23 UTC (permalink / raw)


On 22/04/2016 09:58, ahlan.marriott@gmail.com wrote:
> On Thursday, 21 April 2016 15:00:04 UTC+2, Dmitry A. Kazakov  wrote:
>> It seems I finally found a way to build it. The solution is quite
>> perplexing. I would be glad if anybody could shed some light on it.
>>
>> An encapsulated library requires that -lws2_32 -lwsock32 appeared *both*
>> at the beginning and the end of the linker command line. Only then no
>> "undefined reference" messages appear.
>>
>> For this build this program:
>> --------------------------------------- gcc_wrapper.adb ---
>> with Ada.Command_Line;  use Ada.Command_Line;
>> with Ada.Exceptions;    use Ada.Exceptions;
>> with Ada.Text_IO;       use Ada.Text_IO;
>> with GNAT.OS_Lib;       use GNAT.OS_Lib;
>>
>> procedure GCC_Wrapper is
>>      Prefix : String_List :=
>>               (  new String'("-lwsock32"),
>>                  new String'("-lws2_32")
>>               );
>>      Options : String_List (1..Argument_Count);
>> begin
>>      for No in 1..Argument_Count loop
>>         Options (No) := new String'(Argument (No));
>>      end loop;
>>      declare
>>         List : String_List := Prefix & Options & Prefix;
>>      begin
>>         Put ("gcc.exe");
>>         for No in List'Range loop
>>            Put (" " & List (No).all);
>>         end loop;
>>         New_Line;
>>         Set_Exit_Status (Exit_Status (Spawn ("gcc.exe", List)));
>>      end;
>> exception
>>      when Error : others =>
>>         Put_Line
>>         (  Standard_Error,
>>            "Fault: " & Exception_Information (Error)
>>         );
>>         Set_Exit_Status (2);
>> end GCC_Wrapper;
>> --------------------------------------- gcc_wrapper.adb ---
>>
>> The project file must contain:
>>
>>      package Linker is
>>         for Driver use "<absolute-path-to>/gcc_wrapper.exe";
>>      end Linker;
>>
>> --
>> Regards,
>> Dmitry A. Kazakov
>> http://www.dmitry-kazakov.de
>
> Dear Dmitry,
>
> Is this perhaps the solution to my question "Using Gnat.Sockets in a Windows DLL" that I posted on 8-Dec-2015?

Yes, I think it is the same problem you reported. BTW, I built gprbuild 
from the latest Git sources. That did not fix the problem.

It looks really weird how GCC linker searches libraries under Windows. 
Not to mention its abysmal performance. It takes literally an hour to 
link an executable against 20-30 libraries.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 0%]

* Re: Building an encapsulated library that uses GNAT sockets under Windows
  2016-04-21 12:59  6% Building an encapsulated library that uses GNAT sockets under Windows Dmitry A. Kazakov
@ 2016-04-22  7:58  0% ` ahlan.marriott
  2016-04-22  8:23  0%   ` Dmitry A. Kazakov
  0 siblings, 1 reply; 200+ results
From: ahlan.marriott @ 2016-04-22  7:58 UTC (permalink / raw)


On Thursday, 21 April 2016 15:00:04 UTC+2, Dmitry A. Kazakov  wrote:
> It seems I finally found a way to build it. The solution is quite 
> perplexing. I would be glad if anybody could shed some light on it.
> 
> An encapsulated library requires that -lws2_32 -lwsock32 appeared *both* 
> at the beginning and the end of the linker command line. Only then no 
> "undefined reference" messages appear.
> 
> For this build this program:
> --------------------------------------- gcc_wrapper.adb ---
> with Ada.Command_Line;  use Ada.Command_Line;
> with Ada.Exceptions;    use Ada.Exceptions;
> with Ada.Text_IO;       use Ada.Text_IO;
> with GNAT.OS_Lib;       use GNAT.OS_Lib;
> 
> procedure GCC_Wrapper is
>     Prefix : String_List :=
>              (  new String'("-lwsock32"),
>                 new String'("-lws2_32")
>              );
>     Options : String_List (1..Argument_Count);
> begin
>     for No in 1..Argument_Count loop
>        Options (No) := new String'(Argument (No));
>     end loop;
>     declare
>        List : String_List := Prefix & Options & Prefix;
>     begin
>        Put ("gcc.exe");
>        for No in List'Range loop
>           Put (" " & List (No).all);
>        end loop;
>        New_Line;
>        Set_Exit_Status (Exit_Status (Spawn ("gcc.exe", List)));
>     end;
> exception
>     when Error : others =>
>        Put_Line
>        (  Standard_Error,
>           "Fault: " & Exception_Information (Error)
>        );
>        Set_Exit_Status (2);
> end GCC_Wrapper;
> --------------------------------------- gcc_wrapper.adb ---
> 
> The project file must contain:
> 
>     package Linker is
>        for Driver use "<absolute-path-to>/gcc_wrapper.exe";
>     end Linker;
> 
> -- 
> Regards,
> Dmitry A. Kazakov
> http://www.dmitry-kazakov.de

Dear Dmitry,

Is this perhaps the solution to my question "Using Gnat.Sockets in a Windows DLL" that I posted on 8-Dec-2015?

Regards,
Ahlan


^ permalink raw reply	[relevance 0%]

* Building an encapsulated library that uses GNAT sockets under Windows
@ 2016-04-21 12:59  6% Dmitry A. Kazakov
  2016-04-22  7:58  0% ` ahlan.marriott
  0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2016-04-21 12:59 UTC (permalink / raw)


It seems I finally found a way to build it. The solution is quite 
perplexing. I would be glad if anybody could shed some light on it.

An encapsulated library requires that -lws2_32 -lwsock32 appeared *both* 
at the beginning and the end of the linker command line. Only then no 
"undefined reference" messages appear.

For this build this program:
--------------------------------------- gcc_wrapper.adb ---
with Ada.Command_Line;  use Ada.Command_Line;
with Ada.Exceptions;    use Ada.Exceptions;
with Ada.Text_IO;       use Ada.Text_IO;
with GNAT.OS_Lib;       use GNAT.OS_Lib;

procedure GCC_Wrapper is
    Prefix : String_List :=
             (  new String'("-lwsock32"),
                new String'("-lws2_32")
             );
    Options : String_List (1..Argument_Count);
begin
    for No in 1..Argument_Count loop
       Options (No) := new String'(Argument (No));
    end loop;
    declare
       List : String_List := Prefix & Options & Prefix;
    begin
       Put ("gcc.exe");
       for No in List'Range loop
          Put (" " & List (No).all);
       end loop;
       New_Line;
       Set_Exit_Status (Exit_Status (Spawn ("gcc.exe", List)));
    end;
exception
    when Error : others =>
       Put_Line
       (  Standard_Error,
          "Fault: " & Exception_Information (Error)
       );
       Set_Exit_Status (2);
end GCC_Wrapper;
--------------------------------------- gcc_wrapper.adb ---

The project file must contain:

    package Linker is
       for Driver use "<absolute-path-to>/gcc_wrapper.exe";
    end Linker;

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de


^ permalink raw reply	[relevance 6%]

* timer_server triggers Task_Termination handler
@ 2016-04-21 10:23  5% Per Dalgas Jakobsen
  0 siblings, 0 replies; 200+ results
From: Per Dalgas Jakobsen @ 2016-04-21 10:23 UTC (permalink / raw)


Is it correct behaviour when tasks internal to the GNAT run-time causes 
users task_termination handlers to be called?

This behaviour is seen on:
   1) Debian Linux: gnat-5 (Ada 2005, Ada 2012).
   2) AIX: GNAT Pro 6.1.0w (Ada 2005).

A simple demonstration of the issue:

--------------------------------------------------------------------------------
with Ada.Text_IO;
with Log_Unhandled_Exceptions;

procedure Timer_Server_Noise is

begin
    Ada.Text_IO.Put_Line ("Start of main");

    select
       delay 0.5;
    then abort
       loop
          delay 0.1;
       end loop;
    end select;

    Ada.Text_IO.Put_Line ("End of main");
end  Timer_Server_Noise;
--------------------------------------------------------------------------------
with Ada.Exceptions;
with Ada.Task_Identification;
with Ada.Task_Termination;

package Log_Unhandled_Exceptions is

    pragma Elaborate_Body;

    use Ada.Task_Identification;
    use Ada.Task_Termination;
    use Ada.Exceptions;

    --
    protected Last_Wishes is
       procedure Log_Any_Exit (Cause : in Cause_Of_Termination;
                               T     : in Task_Id;
                               E     : in Exception_Occurrence);
    end;

end Log_Unhandled_Exceptions;
--------------------------------------------------------------------------------
with Ada.Text_IO;


package body Log_Unhandled_Exceptions is

    -- Encapsulates the actual log call
    procedure Log (Text : in String) is
    begin
       Ada.Text_IO.Put_Line ("Log_Unhandled_Exceptions >> " &
                               Text);
    end Log;

    --
    protected body Last_Wishes is

       procedure Log_Any_Exit (Cause : in Cause_Of_Termination;
                               T     : in Task_Id;
                               E     : in Exception_Occurrence) is
       begin
          case Cause is
             when Normal =>
                Log ("Normal exit of task: " & Image (T));
             when Abnormal =>
                Log ("Abnormal exit of task: " & Image (T));
             when Unhandled_Exception =>
                Log ("Unhandled exception in task: " & Image (T));
          end case;
       end Log_Any_Exit;

    end Last_Wishes;


begin
    if Current_Task_Fallback_Handler = null then
       Set_Dependents_Fallback_Handler (Last_Wishes.Log_Any_Exit'Access);
    else
       Log ("Fallback handler already set, will not set own handler.");
    end if;

    if Specific_Handler (Current_Task) = null then
       Set_Specific_Handler (Current_Task, Last_Wishes.Log_Any_Exit'Access);

    else
       Log ("Specific handler already set, will not set own handler.");
    end if;
end Log_Unhandled_Exceptions;
--------------------------------------------------------------------------------

~Per

^ permalink raw reply	[relevance 5%]

* ANN: Cortex GNAT RTS 20160314
@ 2016-03-14 17:42  4% Simon Wright
  0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2016-03-14 17:42 UTC (permalink / raw)


At https://sourceforge.net/projects/cortex-gnat-rts/files/20160314/.

This release includes

* an RTS for the Arduino Due, arduino-due, and a minimal BSP,
  arduino-due-bsp.

* an RTS for the STM32F429I-DISCO, stm32f429i-disco-rtos, based on
  STMicroelectronics' STM32Cube package and FreeRTOS, and a
  corresponding partial BSP, stm32f429i-disco-bsp.

* an RTS for the STM32F429I-DISCO, stm32f429i, based on FreeRTOS, with
  a set of peripheral definition packages created by SVD2Ada.

In this release,

* the Containers support generalized iteration ("for all E of C
  loop"). Note, this is achieved by removing tampering checks. While
  tampering errors are rare, it would be as well to check algorithms
  using a fully-featured desktop compiler.

The standard packages included (there are more, implementation-specific,
ones) are:

Ada
Ada.Containers
Ada.Containers.Bounded_Hashed_Maps
Ada.Containers.Bounded_Vectors
Ada.Exceptions
Ada.IO_Exceptions
Ada.Interrupts
Ada.Interrupts.Names
Ada.Iterator_Interfaces
Ada.Real_Time
Ada.Streams
Ada.Synchronous_Task_Control
Ada.Tags
Ada.Task_Identification
Interfaces
Interfaces.C
Interfaces.C.Strings
System
System.Assertions
System.Address_To_Access_Conversions
System.Storage_Elements
GNAT
GNAT.Source_Info


^ permalink raw reply	[relevance 4%]

* Re: Asynchronous channels in Ada
  @ 2016-02-22  8:48  5%   ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2016-02-22  8:48 UTC (permalink / raw)


On 21/02/2016 23:57, Hadrien Grasland wrote:

> Now, something goes wrong on the producer side, for any reason, which
> prevents this task from correctly producing its next data packet.

That cannot happen. You should reconsider your design if you really 
think it could. When the communication channel is up the producer must 
function.

I do not consider the case of a bug in the producer code. But anything 
else is just a valid state. That includes all handled exceptions on the 
producer side.

And any valid producer state must have a corresponding valid state on 
the subscriber's side. This is just basics of any communication protocol 
design.

> Transmit a specially crafted data packet representing an error (i.e. an exception).

This is not an "error" it is a valid state.

There is no problem to marshal an exception to the subscriber side. You 
make the data object like this:

type Data (Abnormal : Boolean := False) is record
    case Abnormal is
       when True =>
          Reason : Ada.Exceptions.Exception_ID;
       when False =>
          ... -- Normal data
    end case;
end record;

Remove default value for Abnormal if your FIFO can handle indefinite 
objects. However, assuming that abnormal data objects are not frequently 
to transmit, making them indefinite might be not necessary.

Regarding bugs, the safest way to handle a bug is to kill the 
application as early as possible. It makes debugging easier.

> I wonder if I could find a way to build such a communication channel
> and reuse existing FIFO implementations without incurring twice the
> synchronization overhead. Most likely I should look into unsynchronized
> FIFO implementations then.

I think any implementation would go.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 5%]

* ANN: Cortex GNAT RTS 20160207
@ 2016-02-07 22:45  4% Simon Wright
  0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2016-02-07 22:45 UTC (permalink / raw)


This release is at Sourceforge[1].

This release includes an RTS for the Arduino Due, arduino-due, and a
minimal BSP, arduino-due-bsp.

For the STM32F429I-DISCO, there is one RTS, stm32f429i-disco-rtos, and
one BSP, stm32f429i-disco-bsp.

In this release,

* the Containers support generalized iteration ("for all E of C
  loop"). Note, this is achieved by removing tampering checks. While
  tampering errors are rare, it would be as well to check algorithms
  using a fully-featured desktop compiler.

* FreeRTOS is configured to detect stack overflow (if it is detected,
  the RTS loops inside vApplicationStackOverflowHook()).

The standard packages included (there are more,
implementation-specific, ones) are:

   Ada
   Ada.Containers
   Ada.Containers.Bounded_Hashed_Maps
   Ada.Containers.Bounded_Vectors
   Ada.Exceptions
   Ada.IO_Exceptions
   Ada.Interrupts
   Ada.Interrupts.Names
   Ada.Iterator_Interfaces
   Ada.Real_Time
   Ada.Streams
   Ada.Synchronous_Task_Control
   Ada.Tags
   Ada.Task_Identification
   Interfaces
   Interfaces.C
   Interfaces.C.Strings
   System
   System.Assertions
   System.Address_To_Access_Conversions
   System.Storage_Elements
   GNAT
   GNAT.Source_Info

The software is supplied built with for debugging (-g) and with suitable
optimisation (-Og), using GNAT GPL 2015 on Mac OS X (it should work
out of the box with a Linux-hosted GNAT GPL 2015 cross-compiler, but
will need recompiling for another compiler version).

[1] https://sourceforge.net/projects/cortex-gnat-rts/files/20160207/


^ permalink raw reply	[relevance 4%]

* Re: Out_File , excess line
  @ 2016-01-31 12:57  5%     ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2016-01-31 12:57 UTC (permalink / raw)


On 2016-01-31 12:25, Simon Wright wrote:

> The standard solution to copying a file would be
>
>     with Ada.Text_IO; use Ada.Text_IO;

No, that does not copy a file. That 1) interprets a file context as a 
text file specific to the given operating system and then 2) writes the 
interpretation into another file. So it is a file conversion.

One solution to copy a file is using Copy_File from Ada.Directories.

Another is using Ada.Streams.Stream_IO. Both are not ideal but will work 
in most cases.

E.g. your example with Ada.Streams.Stream_IO:

  with Ada.Exceptions;        use Ada.Exceptions;
  with Ada.Streams;           use Ada.Streams;
  with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;

  with Ada.Text_IO;

  procedure Fanzine is
     Buffer_Size : constant := 1024; -- Or more
     Input_File  : File_Type;
     Output_File : File_Type;
     Buffer      : Stream_Element_Array (1..Buffer_Size);
     Last        : Stream_Element_Offset;
     Count       : Stream_Element_Count := 0;
  begin
     Open (Input_File, In_File, "fanzine.adb");
     begin
        Create (Output_File, Out_File, "fanzine.adb.copy");
        loop
           Read (Input_File, Buffer, Last);
           exit when Last < Buffer'First;
           Count := Count + Last;
           Write (Output_File, Buffer (Buffer'First..Last));
       end loop;
    exception
       when End_Error =>
          null; -- Never here
    end;
    Close (Output_File);
    Close (Input_File);
    Ada.Text_IO.Put_Line
    (  "Written" & Stream_Element_Count'Image (Count) & " elements"
    );
exception
    when Error : others =>
       Ada.Text_IO.Put_Line ("Error " & Exception_Information (Error));
end Fanzine;

It is quite simple, if necessary, to detect line ends in a manner 
compatible with both Windows and Linux systems, given fixed encoding.

(Doing that independently of the encoding would probably be impossible, 
but who cares?)

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 5%]

* Re: Re-write a file in Ada
  @ 2016-01-19 16:52  7%         ` gautier_niouzes
  0 siblings, 0 replies; 200+ results
From: gautier_niouzes @ 2016-01-19 16:52 UTC (permalink / raw)


On Tuesday, January 19, 2016 at 1:27:22 PM UTC+1, Brian Drummond wrote:

> Agreed. Traceback would be very helpful. Because I can never remember 
> how, I'll outline it here, partly in the hope of memorising it. From
> 
> https://gcc.gnu.org/onlinedocs/gnat_ugn/Non-Symbolic-Traceback.html#Non-
> Symbolic-Traceback

There is a way that doesn't need calling post-mortem addr2line: wrap your main procedure with the TB_Wrap generic procedure below, by instanciating the wrapper like this:
  with TB_Wrap, To_BMP;
  pragma Elaborate_All(TB_Wrap);
  procedure TB_To_BMP is new TB_Wrap(To_BMP);

_________________________ 
Gautier's Ada programming 
http://www.openhub.net/accounts/gautier_bd

-----------------------------------------------------------------------
--  File:            TB_Wrap.ads
--  Description:     Trace-back wrapper for GNAT 3.13p+ (spec.)
-----------------------------------------------------------------------

generic
  with procedure My_main_procedure;
procedure TB_Wrap;

---------------------------------------------------------------------------
--  File:            TB_Wrap.adb
--  Description:     Trace-back wrapper for GNAT 3.13p+ (body)
---------------------------------------------------------------------------

with GNAT.Traceback.Symbolic, Ada.Exceptions, Ada.Text_IO;
use Ada.Exceptions, Ada.Text_IO;

procedure TB_Wrap is
  --  pragma Compiler_options("-g");
  --  pragma Binder_options("-E");
begin
  My_main_procedure;
exception
  when E: others =>
    New_Line(Standard_Error);
    Put_Line(Standard_Error,
             "------------------[ Unhandled exception ]---------------");
    Put_Line(Standard_Error, " > Name of exception . . . . .: " &
             Ada.Exceptions.Exception_Name(E) );
    Put_Line(Standard_Error, " > Message for exception . . .: " &
             Ada.Exceptions.Exception_Message(E) );
    Put_Line(Standard_Error, " > Trace-back of call stack: " );
    Put_Line(Standard_Error, GNAT.Traceback.Symbolic.Symbolic_Traceback(E) );
end TB_Wrap;


^ permalink raw reply	[relevance 7%]

* Re: What do you think about this?
  2015-06-25  7:29  5%                               ` Simon Wright
  2015-06-25 16:55  0%                                 ` Anh Vo
@ 2015-06-25 18:13  0%                                 ` Laurent
  1 sibling, 0 replies; 200+ results
From: Laurent @ 2015-06-25 18:13 UTC (permalink / raw)


On Thursday, 25 June 2015 09:29:45 UTC+2, Simon Wright  wrote:
> 
> > Houston we have a problem: Exception name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
> > Message: failed precondition from common_defs_bci.ads:19
> > Load address: 0x1070dc000
> > Call stack traceback locations:
> > 0x107111931 0x1070e35f1 0x1070ddf8c 0x1070de763 0x1070de147 0x1070df063
> >
> > 0x0000000107111931
> > 0x00000001070E35F1
> > 0x00000001070DDF8C
> > 0x00000001070DE763
> > 0x00000001070DE147
> > 0x00000001070DF063
> >
> > I can interpret the 3 first lines. For the rest I will ask my cat(s).
> 
> GNAT.Traceback.Symbolic isn't useful on Mac OS X; all it does is report
> the absolute addresses of the stack trace without interpretation. The
> fact it does so on multiple lines addes to the inconvenience.
> 
> My little example (written for another purpose) is:
> 
>    with Ada.Exceptions;
>    with Ada.Text_IO; use Ada.Text_IO;
>    procedure Raiser is
>    begin
>       begin
>          raise Constraint_Error;
>       exception
>          when E : Constraint_Error =>
>             Put_Line ("CE raised.");
>             Put_Line (Ada.Exceptions.Exception_Information (E));
>             raise;
>       end;
>    end Raiser;
> 
> and when I run it I get (GNAT GPL 201[4,5], FSF GCC)
> 
>    $ ./raiser 
>    CE raised.
>    Exception name: CONSTRAINT_ERROR
>    Message: raiser.adb:6 explicit raise
>    Load address: 0x101819000
>    Call stack traceback locations:
>    0x10181a987 0x10181a925
> 
> 
>    Execution terminated by unhandled exception
>    Exception name: CONSTRAINT_ERROR
>    Message: raiser.adb:6 explicit raise
>    Load address: 0x101819000
>    Call stack traceback locations:
>    0x10181a987 0x10181a925
> 
> The first set of messages is from Exception_Information, the last
> because of dropping out of the main program.
> 
> The linker, by default, generates position-independent executables
> (protection against viruses); the Load address line is where we happened
> to get loaded this time.
> 
> To decode the stack traceback, use atos
> 
>    $ atos -d -o raiser -l 0x101819000 0x10181a987 0x10181a925
>    got symbolicator for raiser, base address 100000000
>    _ada_raiser (in raiser) (raiser.adb:6)
>    main (in raiser) (b~raiser.adb:197)
> 
> (run atos without -d to see why it's there!)

Hm I checked the man pages for atos on Yosemite. No -d option. The whole thing is just providing some clues where to look for the error. In my case I have assigned a string which is longer than max length. I know where to find the error because it was intentional. But if not and the program is much larger, well good luck then to find it.


^ permalink raw reply	[relevance 0%]

* Re: What do you think about this?
  2015-06-25  7:29  5%                               ` Simon Wright
@ 2015-06-25 16:55  0%                                 ` Anh Vo
  2015-06-25 18:13  0%                                 ` Laurent
  1 sibling, 0 replies; 200+ results
From: Anh Vo @ 2015-06-25 16:55 UTC (permalink / raw)


On Thursday, June 25, 2015 at 12:29:45 AM UTC-7, Simon Wright wrote:
> Laurent <lutgenl@icloud.com> writes:
> 
> > Houston we have a problem: Exception name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
> > Message: failed precondition from common_defs_bci.ads:19
> > Load address: 0x1070dc000
> > Call stack traceback locations:
> > 0x107111931 0x1070e35f1 0x1070ddf8c 0x1070de763 0x1070de147 0x1070df063
> >
> > 0x0000000107111931
> > 0x00000001070E35F1
> > 0x00000001070DDF8C
> > 0x00000001070DE763
> > 0x00000001070DE147
> > 0x00000001070DF063
> >
> > I can interpret the 3 first lines. For the rest I will ask my cat(s).
> 
> GNAT.Traceback.Symbolic isn't useful on Mac OS X; all it does is report
> the absolute addresses of the stack trace without interpretation. The
> fact it does so on multiple lines addes to the inconvenience.
> 
> My little example (written for another purpose) is:
> 
>    with Ada.Exceptions;
>    with Ada.Text_IO; use Ada.Text_IO;
>    procedure Raiser is
>    begin
>       begin
>          raise Constraint_Error;
>       exception
>          when E : Constraint_Error =>
>             Put_Line ("CE raised.");
>             Put_Line (Ada.Exceptions.Exception_Information (E));
>             raise;
>       end;
>    end Raiser;
> 
> and when I run it I get (GNAT GPL 201[4,5], FSF GCC)
> 
>    $ ./raiser 
>    CE raised.
>    Exception name: CONSTRAINT_ERROR
>    Message: raiser.adb:6 explicit raise
>    Load address: 0x101819000
>    Call stack traceback locations:
>    0x10181a987 0x10181a925
> 
> 
>    Execution terminated by unhandled exception
>    Exception name: CONSTRAINT_ERROR
>    Message: raiser.adb:6 explicit raise
>    Load address: 0x101819000
>    Call stack traceback locations:
>    0x10181a987 0x10181a925
> 
> The first set of messages is from Exception_Information, the last
> because of dropping out of the main program.
> 
> The linker, by default, generates position-independent executables
> (protection against viruses); the Load address line is where we happened
> to get loaded this time.
> 
> To decode the stack traceback, use atos
> 
>    $ atos -d -o raiser -l 0x101819000 0x10181a987 0x10181a925
>    got symbolicator for raiser, base address 100000000
>    _ada_raiser (in raiser) (raiser.adb:6)
>    main (in raiser) (b~raiser.adb:197)
 
What happens if you insert the below line before raise statement?

      Put_Line (Traceback.Symbolic.Symbolic_Traceback(Err));




^ permalink raw reply	[relevance 0%]

* Re: What do you think about this?
  @ 2015-06-25  7:29  5%                               ` Simon Wright
  2015-06-25 16:55  0%                                 ` Anh Vo
  2015-06-25 18:13  0%                                 ` Laurent
  0 siblings, 2 replies; 200+ results
From: Simon Wright @ 2015-06-25  7:29 UTC (permalink / raw)


Laurent <lutgenl@icloud.com> writes:

> Houston we have a problem: Exception name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
> Message: failed precondition from common_defs_bci.ads:19
> Load address: 0x1070dc000
> Call stack traceback locations:
> 0x107111931 0x1070e35f1 0x1070ddf8c 0x1070de763 0x1070de147 0x1070df063
>
> 0x0000000107111931
> 0x00000001070E35F1
> 0x00000001070DDF8C
> 0x00000001070DE763
> 0x00000001070DE147
> 0x00000001070DF063
>
> I can interpret the 3 first lines. For the rest I will ask my cat(s).

GNAT.Traceback.Symbolic isn't useful on Mac OS X; all it does is report
the absolute addresses of the stack trace without interpretation. The
fact it does so on multiple lines addes to the inconvenience.

My little example (written for another purpose) is:

   with Ada.Exceptions;
   with Ada.Text_IO; use Ada.Text_IO;
   procedure Raiser is
   begin
      begin
         raise Constraint_Error;
      exception
         when E : Constraint_Error =>
            Put_Line ("CE raised.");
            Put_Line (Ada.Exceptions.Exception_Information (E));
            raise;
      end;
   end Raiser;

and when I run it I get (GNAT GPL 201[4,5], FSF GCC)

   $ ./raiser 
   CE raised.
   Exception name: CONSTRAINT_ERROR
   Message: raiser.adb:6 explicit raise
   Load address: 0x101819000
   Call stack traceback locations:
   0x10181a987 0x10181a925


   Execution terminated by unhandled exception
   Exception name: CONSTRAINT_ERROR
   Message: raiser.adb:6 explicit raise
   Load address: 0x101819000
   Call stack traceback locations:
   0x10181a987 0x10181a925

The first set of messages is from Exception_Information, the last
because of dropping out of the main program.

The linker, by default, generates position-independent executables
(protection against viruses); the Load address line is where we happened
to get loaded this time.

To decode the stack traceback, use atos

   $ atos -d -o raiser -l 0x101819000 0x10181a987 0x10181a925
   got symbolicator for raiser, base address 100000000
   _ada_raiser (in raiser) (raiser.adb:6)
   main (in raiser) (b~raiser.adb:197)

(run atos without -d to see why it's there!)


^ permalink raw reply	[relevance 5%]

* Re: Trying to make XMLada use a validating SAX Parser
  @ 2015-06-05 15:47  5%   ` Serge Robyns
  0 siblings, 0 replies; 200+ results
From: Serge Robyns @ 2015-06-05 15:47 UTC (permalink / raw)


Dear Simon,

Thank you very much for the hint.  It does indeed work as suggested.

It is very disappointing that the "official" documentation of Ada Core does described "legacy". Going through almost 200 sources files is not the ideal way to achieve success.  I've been wasting many evening hours trying to figure out this issue.  Such hurdles will certainly not help attracting people to Ada.  If I wasn't convinced about code and language quality I would have given up and used more hype languages.

Below the code that does do all what I want (well here only debugging as creating objects from XML will be fine).  I share this so others could stumble on it when Google-ing.

=== MyXML.ads ===
with Sax.Readers;
with Sax.Utils;
with Sax.Symbols;
with Schema.Readers;

package MyXML is
   -- type MyReader is new Sax.Readers.Sax_Reader with null record;
   type MyReader is new Schema.Readers.Validating_Reader with null record;

   overriding procedure Start_Element
     (Handler    : in out MyReader;
      NS         : Sax.Utils.XML_NS;
      Local_Name : Sax.Symbols.Symbol;
      Atts       : Sax.Readers.Sax_Attribute_List);

end MyXML;

=== MyXML.adb ==
with Ada.Text_IO; use Ada.Text_IO;

package body MyXML is

   procedure Start_Element
     (Handler    : in out MyReader;
      NS         : Sax.Utils.XML_NS;
      Local_Name : Sax.Symbols.Symbol;
      Atts       : Sax.Readers.Sax_Attribute_List) is
   begin
      Put_Line (Sax.Symbols.Debug_Print (Local_Name));
      for I in 1 .. Sax.Readers.Get_Length (Atts) loop
         Put_Line (Sax.Symbols.Debug_Print (Sax.Readers.Get_Value (Atts, I)));
      end loop;
   end Start_Element;

end MyXML;


=== SaxTester.adb ===
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Exceptions;

with Input_Sources.File;
with Sax;
with Sax.Readers;
with Schema.Validators;

with MyXML; use MyXML;

procedure SaxTester is
   Input     : Input_Sources.File.File_Input;
   My_Reader : MyReader;
begin
   Put_Line ("Start");

   Input_Sources.File.Open ("transactions.xml", Input);
   My_Reader.Set_Feature (SAX.Readers.Schema_Validation_Feature, True);
   My_Reader.Parse (Input);
   Input.Close;

exception
   when Schema.Validators.XML_Validation_Error
      => Put_Line ("Invalid transaction file!");
      raise;
   when Except_ID : others
      => Put_Line ("Got Exception");
      Put_Line (Ada.Exceptions.Exception_Information (Except_ID));

end SaxTester;


^ permalink raw reply	[relevance 5%]

* Re: Arm - ravenscar - exceptions - last chance handler
  2015-05-30 16:50  0%     ` Simon Wright
@ 2015-05-30 20:59  0%       ` jan.de.kruyf
  0 siblings, 0 replies; 200+ results
From: jan.de.kruyf @ 2015-05-30 20:59 UTC (permalink / raw)



> > The unresolved symbols point to the full native (linux) runtime.  So I
> > replaces the "raise" statements in the ravenscar runtime packages I
> > use with an explicit Ada.Exceptions.Raise_Exception (...); (this then
> > from the ravenscar profile) which I understand to be the
> > recommendation from the Exeptions package's comment.
> 
> I have no trouble with either form. Does your system.ads include
>    pragma Restrictions (No_Exception_Propagation);
> ?

ow that a good point, I might have fiddled with it. let me check next week.

thanks,

j

^ permalink raw reply	[relevance 0%]

* Re: Arm - ravenscar - exceptions - last chance handler
  2015-05-30 16:10  6%   ` jan.de.kruyf
@ 2015-05-30 16:50  0%     ` Simon Wright
  2015-05-30 20:59  0%       ` jan.de.kruyf
  0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2015-05-30 16:50 UTC (permalink / raw)


jan.de.kruyf@gmail.com writes:

> The unresolved symbols point to the full native (linux) runtime.  So I
> replaces the "raise" statements in the ravenscar runtime packages I
> use with an explicit Ada.Exceptions.Raise_Exception (...); (this then
> from the ravenscar profile) which I understand to be the
> recommendation from the Exeptions package's comment.

I have no trouble with either form. Does your system.ads include
   pragma Restrictions (No_Exception_Propagation);
?


^ permalink raw reply	[relevance 0%]

* Re: Arm - ravenscar - exceptions - last chance handler
  2015-05-30 15:43  0% ` Simon Wright
@ 2015-05-30 16:14  0%   ` jan.de.kruyf
  0 siblings, 0 replies; 200+ results
From: jan.de.kruyf @ 2015-05-30 16:14 UTC (permalink / raw)


On Saturday, May 30, 2015 at 5:43:38 PM UTC+2, Simon Wright wrote:

> 
> > Could someone interprete this code for me (from the runtime) and advise
> >
> >    procedure Raise_Exception (E : Exception_Id; Message : String := "") is
> >       pragma Unreferenced (E);
> >
> >       procedure Last_Chance_Handler (Msg : System.Address; Line : Integer);
> >       pragma Import (C, Last_Chance_Handler, "__gnat_last_chance_handler");
> >       pragma No_Return (Last_Chance_Handler);
> >
> >    begin
> >       Last_Chance_Handler (Message'Address, 0);
> >    end Raise_Exception;
> >
> > end Ada.Exceptions;
> > --------------------------------
> >
> > How is last chance handler going to know the --length-- of the message?
> >
> > because I like to issue a printk before I die when in the linux kernel.
> >
> > I have used last chance handler in gdb by looking at the memory, but
> > kernel modules are not debugged that way.
> 
> FWIW [arm-eabi-]gdb doesn't handle "Msg : System.Address" at all well;
> it works much better if you actually write __gnat_last_chance_handler in
> C rather than in Ada with an Export:
> 
> #include <FreeRTOS.h>
> #include <task.h>
> 
> __attribute__((weak))
> void __gnat_last_chance_handler(const char *message, int line) {
>   taskDISABLE_INTERRUPTS();
>   vTaskSuspendAll();
>   // Loop indefinitely: use the debugger to examine the backtrace.
>   while (1) {}
> }

Thanks, Simon.
See my answer to Bob Duff for the full story. I like your C solution, but in my case I will have to kick the bucket and unload myself. At least I believe thats what expected in linux kernel land.

cheers,

j.

^ permalink raw reply	[relevance 0%]

* Re: Arm - ravenscar - exceptions - last chance handler
  @ 2015-05-30 16:10  6%   ` jan.de.kruyf
  2015-05-30 16:50  0%     ` Simon Wright
  0 siblings, 1 reply; 200+ results
From: jan.de.kruyf @ 2015-05-30 16:10 UTC (permalink / raw)


On Saturday, May 30, 2015 at 5:31:41 PM UTC+2, Bob Duff wrote:

> 
> > How is last chance handler going to know the --length-- of the message?
> 
> It's a NUL-terminated string, as the comment in the spec says:
> 
>    procedure Raise_Exception (E : Exception_Id; Message : String := "");
>    pragma No_Return (Raise_Exception);
>    --  Unconditionally call __gnat_last_chance_handler. Message should be a
>    --  null terminated string. Note that the exception is still raised even
>    --  if E is the null exception id. This is a deliberate simplification for
>    --  this profile (the use of Raise_Exception with a null id is very rare in
>    --  any case, and this way we avoid introducing Raise_Exception_Always and
>    --  we also avoid the if test in Raise_Exception).
> 
> > If we say that I have to append an ASCII.NUL when I raise an exception
> > then it runs havoc with the other runtime modules where exceptions are
> > used.
> 
> Why?  To raise an exception, you just say "raise Some_Exception;".
> No need to fool about with ASCII.NUL, except in the last-chance
> handler itself; the default version says:
> 
>          exit when Msg_Str (J) = Character'Val (0);
> 
> - Bob

Yes bob,
I saw that NUL terminated part just after I posted, so I tried to delete the post, but that is hard :) apparently.

In any case there is a more serious issue I think (in ravenscar).
I get unresolved symbols in a partial link caused by "raise exeption". 
(partial link since this is a kernel module)

The unresolved symbols point to the full native (linux) runtime.
So I replaces the "raise" statements in the ravenscar runtime packages I use with an explicit 
Ada.Exceptions.Raise_Exception (...);  (this then from the ravenscar profile)
which I understand to be the recommendation from the Exeptions package's comment.

That works, but some of the runtime packages are marked "pure" so they cannot depend on Ada.Exceptions.

There is still another issue, but I will post that when I am finished. If needed.

Peace,

j.



^ permalink raw reply	[relevance 6%]

* Re: Arm - ravenscar - exceptions - last chance handler
  2015-05-30 14:26  6% Arm - ravenscar - exceptions - last chance handler jan.de.kruyf
  @ 2015-05-30 15:43  0% ` Simon Wright
  2015-05-30 16:14  0%   ` jan.de.kruyf
  1 sibling, 1 reply; 200+ results
From: Simon Wright @ 2015-05-30 15:43 UTC (permalink / raw)


jan.de.kruyf@gmail.com writes:

> Could someone interprete this code for me (from the runtime) and advise
>
>    procedure Raise_Exception (E : Exception_Id; Message : String := "") is
>       pragma Unreferenced (E);
>
>       procedure Last_Chance_Handler (Msg : System.Address; Line : Integer);
>       pragma Import (C, Last_Chance_Handler, "__gnat_last_chance_handler");
>       pragma No_Return (Last_Chance_Handler);
>
>    begin
>       Last_Chance_Handler (Message'Address, 0);
>    end Raise_Exception;
>
> end Ada.Exceptions;
> --------------------------------
>
> How is last chance handler going to know the --length-- of the message?
>
> because I like to issue a printk before I die when in the linux kernel.
>
> I have used last chance handler in gdb by looking at the memory, but
> kernel modules are not debugged that way.

FWIW [arm-eabi-]gdb doesn't handle "Msg : System.Address" at all well;
it works much better if you actually write __gnat_last_chance_handler in
C rather than in Ada with an Export:

#include <FreeRTOS.h>
#include <task.h>

__attribute__((weak))
void __gnat_last_chance_handler(const char *message, int line) {
  taskDISABLE_INTERRUPTS();
  vTaskSuspendAll();
  // Loop indefinitely: use the debugger to examine the backtrace.
  while (1) {}
}

^ permalink raw reply	[relevance 0%]

* Arm - ravenscar - exceptions - last chance handler
@ 2015-05-30 14:26  6% jan.de.kruyf
    2015-05-30 15:43  0% ` Simon Wright
  0 siblings, 2 replies; 200+ results
From: jan.de.kruyf @ 2015-05-30 14:26 UTC (permalink / raw)



Could someone interprete this code for me (from the runtime) and advise

-------------------------------
package body Ada.Exceptions is

   ---------------------
   -- Raise_Exception --
   ---------------------

   procedure Raise_Exception (E : Exception_Id; Message : String := "") is
      pragma Unreferenced (E);

      procedure Last_Chance_Handler (Msg : System.Address; Line : Integer);
      pragma Import (C, Last_Chance_Handler, "__gnat_last_chance_handler");
      pragma No_Return (Last_Chance_Handler);

   begin
      Last_Chance_Handler (Message'Address, 0);
   end Raise_Exception;

end Ada.Exceptions;
--------------------------------

How is last chance handler going to know the --length-- of the message?

because I like to issue a printk before I die when in the linux kernel.

I have used last chance handler in gdb by looking at the memory, but kernel modules are not debugged that way.

If we say that I have to append an ASCII.NUL when I raise an exception then it runs havoc with the other runtime modules where exceptions are used.

Thanks,

j.


^ permalink raw reply	[relevance 6%]

* I've not seen this error before
@ 2015-04-01  8:42  4% tonyg
  0 siblings, 0 replies; 200+ results
From: tonyg @ 2015-04-01  8:42 UTC (permalink / raw)



2015-04-01 09:19:32.10 : Exception name: PROGRAM_ERROR
Message: adjust/finalize raised PROGRAM_ERROR: device_type_pkg.ads:115 finalize/adjust raised exception

the code is an ada specification

 type Device_Details_Type is record
      Device_Id : Device_Index_Type;
      The_Device : Device_Class_Type;
      Room_Id : Room_Id_Type;
      The_Id : Domoticz_ID_Type;
      Battery_Level : Battery_Level_Type;
      Signal_Level : Signal_Level_Type;
      Name : SU.Unbounded_String;
      Last_Update : AC.Time;
      Used : boolean ;
      Successful_Initialisation : boolean := false;
      Temperature : Temp_Xten_Type;
      Protected_Device : boolean; 
   end record;

The stack trace passed through addr2line (etc) is different

/home/tony/Dropbox/source/common/schedules_rooms_devices_indexes_pkg.adb:694 (discriminator 3)
/home/tony/Dropbox/source/common/schedules_rooms_devices_indexes_pkg.adb:689
/home/tony/Dropbox/source/common/schedules_rooms_devices_indexes_pkg.adb:342
/home/tony/Dropbox/source/common/schedules_rooms_devices_indexes_pkg.adb:356 (discriminator 2)
/home/tony/Dropbox/source/common/data_feed_update_pkg.adb:73 (discriminator 2)
/home/tony/Dropbox/source/common/data_feed_update_pkg.adb:48
/home/tony/Dropbox/source/common/data_feed_update_pkg.adb:41
/home/tony/Dropbox/source/common/decision_maker_pkg.adb:29 (discriminator 2)
s-tassta.adb:?

which is this and is a procedural call inside a protected object

   procedure Set_Device (Device : in Device_Details_Type) is
        
      begin
         if Initialised then
            gnoga.log("Device id " & Device.Device_Id'img);
            Device_Array(Device.Device_Id) :=Device;   -- LINE 694 where the error is reported
            if Device.Device_Id > 0 then
               Device_File_Storage.Save_Record (File_Item => Device,
                                               To => Device.Device_Id);
            else
               Gnoga.log ("Zero Device Id Device Record  NOT SAVED TO DISK");
            end if;

         else
            Gnoga.Log("Devices not loaded from disk");
         end if;

        
      exception
         when E : others => Gnoga.log (Ada.Exceptions.Exception_Information (E));

      end Set_Device;


The array that is being written to is a fixed array. There is a value of Ada.Calendar.Time in the record but I cannot see why this would cause the problem

^ permalink raw reply	[relevance 4%]

* Re: Access parameters and accessibility
  2014-12-17  2:02  4%     ` Adam Beneschan
@ 2014-12-17 23:18  0%       ` Randy Brukardt
  0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2014-12-17 23:18 UTC (permalink / raw)


"Adam Beneschan" <adambeneschan@gmail.com> wrote in message 
news:eea29e4c-921a-467c-8007-80e80eda3507@googlegroups.com...
On Tuesday, December 16, 2014 11:46:59 AM UTC-8, Michael B. wrote:
...
>I'm sure Randy was being tongue-in-cheek when he said "get better 
>libraries".

Ahh, no.

...
>For one thing, you'd have to get better libraries than the libraries Ada 
>provides,
>because Ada defines some subprograms with anonymous access 
>parameters--namely
>Ada.Tags.Generic_Dispatching_Constructor, Ada.Execution_Time.Timers.Timer, 
>and >Read|Write_Exception_Occurrence in Ada.Exceptions. Also, the stream 
>attribute
>subprograms ('Read, 'Write, etc.) all have anonymous access parameters, and 
>you
>have to *write* a subprogram that has an anonymous access parameter in 
>order to
>use it as the stream subprogram for a type.  Quelle horreur!

Yup. With the exception of timers, all of the others stem directly from the 
mistake of using an anonymous access for streams. And *that* stems from the 
mistake of not allowing "in out" parameters for functions (as Input is a 
function).

Ergo, in Ada 2012 you would write those as "in out Root_Stream_Type'Class". 
And one should think of them as exactly that. (It's too late to fix this 
mistake, sadly.)

In the case of Timer, (a) no one ever uses this feature, and (b) I have no 
idea why this just isn't

type Timer (T : Ada.Task_Identification.Task_Id) is tagged limited private;

I have no idea who has an aliased Task_Id laying around anyway. That seems 
amazingly hard to use for no value whatsoever. I suspect it was something 
else originally and it never got changed sensibly.

>Anyway, I think you can avoid defining new subprograms that take anonymous 
>access
>parameters (except where needed for streams, or for 
>Generic_Dispatching_Constructor)
>and not add to the problem, but I don't see any value in avoiding existing 
>libraries.

Well, if you could tell a-priori if "access" was used as a stand-in for "in 
out", then it would be OK. In that case, the only use of the "access" is to 
dereference it.

But it if is actually used as an access type (with the access value being 
copied somewhere), then you have trouble (with random Program_Errors and a 
need to avoid passing local objects). It's possible in Ada 2012 to write a 
precondition for this case, but of course that's not required (and surely is 
not found in existing libraries), so the possibility doesn't help much.

Since you can't tell these cases apart (and the first is never necessary in 
Ada 2012 anyway, with the possible exception of foreign conventions), it's 
best to just avoid the feature. Especially as "access" is more expensive 
than "in out" because of the dynamic accessibility checking overhead (which 
exists regardless of whether it is ever used). Libraries should reflect this 
(moreso as Ada 2012 gets adopted more).

                                Randy.


^ permalink raw reply	[relevance 0%]

* Re: Access parameters and accessibility
  @ 2014-12-17  2:02  4%     ` Adam Beneschan
  2014-12-17 23:18  0%       ` Randy Brukardt
  0 siblings, 1 reply; 200+ results
From: Adam Beneschan @ 2014-12-17  2:02 UTC (permalink / raw)


On Tuesday, December 16, 2014 11:46:59 AM UTC-8, Michael B. wrote:

> > Besides, I agree with the others that it has nothing to do with OOP. Claw
> > only uses anonymous access parameters to get the effect of in out parameters
> > in functions (which isn't a problem with Ada 2012 anyway), and as Dmitry
> > noted, it doesn't work very well. Anonymous access parameters: just say no!!
> 
> How can I avoid them when they are heavily used in so many libraries?
> E.g. GtkAda: I just looked into some arbitrary .ads files from Gnat GPL 
> 2014 (glib-string.ads, glib-object.ads and gdk-event.ads) and found 
> examples of the usage of anonymous access parameters.
> You could argue that this is bad design, but rewriting all this code is 
> not really an option for me.
> And compared to writing GUIs in plain C it seems to be the lesser of two 
> evils.

I don't see how it could be a problem if you *use* a subprogram that requires an anonymous access parameter.  You can pretty much just pass in an object of any matching named access type, or 'Access (or 'Unchecked_Access) of a matching object.  You don't need to create any new anonymous access types in order to do so.

I'm sure Randy was being tongue-in-cheek when he said "get better libraries".  For one thing, you'd have to get better libraries than the libraries Ada provides, because Ada defines some subprograms with anonymous access parameters--namely Ada.Tags.Generic_Dispatching_Constructor, Ada.Execution_Time.Timers.Timer, and Read|Write_Exception_Occurrence in Ada.Exceptions.  Also, the stream attribute subprograms ('Read, 'Write, etc.) all have anonymous access parameters, and you have to *write* a subprogram that has an anonymous access parameter in order to use it as the stream subprogram for a type.  Quelle horreur!  Anyway, I think you can avoid defining new subprograms that take anonymous access parameters (except where needed for streams, or for Generic_Dispatching_Constructor) and not add to the problem, but I don't see any value in avoiding existing libraries.

                                -- Adam


^ permalink raw reply	[relevance 4%]

* Re: How to get nice with GNAT?
    2014-11-21 12:42  7% ` Björn Lundin
@ 2014-11-22 10:11  7% ` gautier_niouzes
  1 sibling, 0 replies; 200+ results
From: gautier_niouzes @ 2014-11-22 10:11 UTC (permalink / raw)


Below, a generic solution, unchanged since around year 2000.
This way you can have a pure Ada program but a decent GNAT trace-back.
Why AdaCore never made it just to include these few Put_Line in their run-time is a bit a mystery.
_________________________ 
Gautier's Ada programming 
http://sf.net/users/gdemont

------------------------------------------------------------------------------
--  File:            TB_Wrap.ads
--  Description:     Trace-back wrapper for GNAT 3.13p+ (spec.)
------------------------------------------------------------------------------

generic

  with procedure My_main_procedure;

procedure TB_Wrap;


------------------------------------------------------------------------------
--  File:            TB_Wrap.adb
--  Description:     Trace-back wrapper for GNAT 3.13p+ (body)
------------------------------------------------------------------------------

with GNAT.Traceback.Symbolic, Ada.Exceptions, Ada.Text_IO;
use Ada.Text_IO;

procedure TB_Wrap is
  --  pragma Compiler_options("-g");
  --  pragma Binder_options("-E");
begin
  My_main_procedure;
exception
  when E: others =>
    New_Line;
    Put_Line("--------------------[ Unhandled exception ]-----------------");
    Put_Line(" > Name of exception . . . . .: " &
             Ada.Exceptions.Exception_Name(E) );
    Put_Line(" > Message for exception . . .: " &
             Ada.Exceptions.Exception_Message(E) );
    Put_Line(" > Trace-back of call stack: " );
    Put_Line( GNAT.Traceback.Symbolic.Symbolic_Traceback(E) );
end TB_Wrap;

^ permalink raw reply	[relevance 7%]

* Re: How to get nice with GNAT?
  @ 2014-11-21 12:42  7% ` Björn Lundin
  2014-11-22 10:11  7% ` gautier_niouzes
  1 sibling, 0 replies; 200+ results
From: Björn Lundin @ 2014-11-21 12:42 UTC (permalink / raw)


On 2014-11-21 12:41, Natasha Kerensikova wrote:


> As a user, is there something I can do to improve the traceback
> representation on those platforms?
> Or is it completely in the hands of the GNAT packager/maintainer?
>

I run gnat on Aix/win32/linux32/64
and until recently, I tucked everything related
to stacktrace into a package Stacktrace.


package Stacktrace is
  procedure Tracebackinfo(E : Ada.Exceptions.Exception_Occurrence) ;
end Stacktrace;

used as

procedure bla is
...
...
exception
  when E: others =>
  Stacktrace.Tracebackinfo(E);
end ;

where i called
Ada.Exceptions.Exception_Name(E);
Ada.Exceptions.Exception_Message(E);
Ada.Exceptions.Exception_Information(E);

and output them

however, from Gnat GPL 2014 (64) and gnat fsf on debian Jessie
 (gnat 4.9 i think) the Tracebackinfo is not called anymore.

So my current workaround is to print those function directly
like

procedure bla is
...

exception
  when E: others =>
    declare
      Last_Exception_Name     : constant String  :=
Ada.Exceptions.Exception_Name(E);
      Last_Exception_Messsage : constant String  :=
Ada.Exceptions.Exception_Message(E);
      Last_Exception_Info     : constant String  :=
Ada.Exceptions.Exception_Information(E);
    begin
      Log(Last_Exception_Name);
      Log("Message : " & Last_Exception_Messsage);
      Log(Last_Exception_Info);
      Log("addr2line" & " --functions --basenames --exe=" &
           Ada.Command_Line.Command_Name & " " &
Stacktrace.Pure_Hexdump(Last_Exception_Info));
    end ;

end bla;



the function Pure_Hexdump strips away
everything before the first 0x in the string.


final output is like

2014-11-21 13:33:26.278 SQL.NOT_CONNECTED
2014-11-21 13:33:26.278 Message : Sql.Connect: Not_Connected
2014-11-21 13:33:26.278 Exception name: SQL.NOT_CONNECTED
Message: Sql.Connect: Not_Connected
Call stack traceback locations:
0x5be389 0x5cd93c 0x40c988 0x7fca95a8beab 0x40bab7

2014-11-21 13:33:26.278 addr2line --functions --basenames
--exe=/home/bnl/bnlbot/botstart/bot-1-0/target/bin/back_hitrate 0x5be389
0x5cd93c 0x40c988 0x7fca95a8beab 0x40bab7

and running addr2line gives

 addr2line --functions --basenames
--exe=/home/bnl/bnlbot/botstart/bot-1-0/target/bin/back_hitrate 0x5be389
0x5cd93c 0x40c988 0x7fca95a8beab 0x40bab7
sql__connect
sql.adb:432
_ada_back_hitrate
back_hitrate.adb:165
main
b~back_hitrate.adb:761
??
??:0
_start
??:?


A bit clumpsy but good enough for my _hobby_ projects.

--
Björn

^ permalink raw reply	[relevance 7%]

* Re: one task missing during the execution
  @ 2014-10-16 21:25  7%       ` compguy45
  0 siblings, 0 replies; 200+ results
From: compguy45 @ 2014-10-16 21:25 UTC (permalink / raw)


I added...

with Ada.Exceptions;  use Ada.Exceptions;
with Ada.Text_IO;     use Ada.Text_IO;

  exception
 when tasking_error =>
            Put_Line ("Something is wrong here" & Exception_Information (Error));
 when others =>
               put("some other error occurred");

I get error xpected private type "Ada.Exceptions.Exception_Occurrence"
 found type "Ada.Strings.Truncation"
" compilation error

when i just say when tasking_error => "Some error" get compiles fine and prints "some error" which tells me there is tasking error....

is there way to get more information about error?

^ permalink raw reply	[relevance 7%]

* Re: 'Size hack for enumerated types
  @ 2014-07-08 22:26  6%                         ` Dan'l Miller
  0 siblings, 0 replies; 200+ results
From: Dan'l Miller @ 2014-07-08 22:26 UTC (permalink / raw)


On Tuesday, July 8, 2014 3:56:25 PM UTC-5, Randy Brukardt wrote:
> We've previously argued about a convention C_Plus_Plus or the like. We 
> decided not to go there for two reasons:
> (1) C_Plus_Plus is unspeakable ugly; C++ is bad syntax. We could get no 
> agreement on the name here.

  This is one of the very few areas where C++ was wiser than Ada:  C++'s analogous syntax is:  extern "C", where the string-quotes quarantine peculiar language names that would pollute the C++ grammar/parser.  I would suggest making Convention => "C" equivalent to Convention => C, then adding Convention => "C++".

> (2) We don't want to support convention C_Plus_Plus (or whatever it ends up 
> being called) on tagged types. Doing so insists that all tagged types are 
> represented as C++ does. That might be OK for GNAT (where the C++ compiler 
> is maintained in tandem), but it wouldn't work very well for any target 
> where the C++ compiler is from a separate organization. (I'm not interested 
> in chasing Microsoft on this, thank you.)

I agree.  There is no way that Ada should have Convention => "C++/CLI" for .NET boxed-type bytecode or Convention => "C++/CX" for boxed-type native machine-code.

> In addition other information is 
> needed which tends to vary between C++ implementations. We didn't think that 
> we could come up with a mechanism that was sufficiently abstract to allow 
> portability between implementations.

1000 pure Ada tagged types would need to conform to C++'s analogue (pointer to virtual-function table) just because 1 tagged type was annotated with Convention => "C++".  What might be too burdensome, is to go through every portion of the LRM to see where conforming to pointer to virtual-function table and non-virtual member-functions would change the Ada semantics for an Ada tagged type with Convention => "C++".

Your list is too short and not pessimistic enough.  There seem far more severe:

3) Name mangling.  Ada would need to conform to the highly-proprietary name-mangling conventions of encoding type information in very-lengthy function names.  In effect, this proprietarianism would seem to require the syntax of with Convention => "C++" to be something to the effect of with Convention => "Microsoft C++" or with Convention => "GNU C++" or with Convention => "Edison Design Group C++".

4) Exceptions.  Ada exceptions have no ability to have user-defined fields in a record that represents the exception.  As soon as full exception compatibility with C++ is admitted into Convention => "C++", then Ada exceptions would need to be expanded to have parity with the C++ expressivity of user-defined fields in exception structs.

> The ultimate decision was that we wouldn't define a C++ convention.

You make the decision sound so permanent, as if it cannot be divided & conquered by even partial attempts at Convention => "C++" that omit tagged types and exceptions.

> Implementations are supposed to have a dedicated convention for every 
> compiler they support. So if the C++ compiler does something different than 
> the C compiler, then the *implementation* should have a separate convention 
> for the C++ compiler. The language need not get involved, as portability 
> between implementations can't be guaranteed anyway.

I assume that you are saying here that portability is an impractical up-hill battle, not mathematically-provably impossible.

^ permalink raw reply	[relevance 6%]

* Re: Safety of unprotected concurrent operations on constant objects
  @ 2014-05-11  6:56  5%                                           ` Brad Moore
  0 siblings, 0 replies; 200+ results
From: Brad Moore @ 2014-05-11  6:56 UTC (permalink / raw)


On 10/05/2014 2:27 PM, Dmitry A. Kazakov wrote:
>> If Foo calls Bar, and both Foo and Bar have the Task_Safe aspect, but
>> some time later the maintainer of Bar decides to change its
>> implementation to refer to some global variable or call some other
>> subprogram that doesn't have the Task_Safe aspect, the compiler would
>> force the programmer to remove the Task_Safe aspect from Bar.
>
> But this rule is just wrong. Calling unsafe operation from a safe one will
> be pretty much safe in most cases. The reverse is likely wrong.

This doesn't make sense to me. There should be no such thing as a Safe 
operation that calls unsafe ones. Wouldn't that mean that the operation 
is unsafe (to use concurrently)?

>
> Compare it with protected actions. It is safe to call an operation which
> itself is not protected from a protected operation on the context of a
> protected action.

But thats only true if the operation is only ever called from within 
that same instance of the protected object (Something that could be 
difficult to know without the aspect), and that there is only one 
instance of that protected type of the protected object. Otherwise its 
not safe to call from a protected operation as there could be other 
concurrent calls calling the unsafe operation.

The following program illustrates this. If you run the program with a 
small value of N (specified on the command line), say 100, then chances 
are the program executes correctly to completion. However if you use a 
larger value of N (say 1_000_000, the default), then the program fails,
due to the use of global variables. In Test1, the Unsafe function is 
called directly from multiple tasks.

In Test2, the same Unsafe function is only called from protected 
functions, but it still fails.
.
In both tests, the failures are due to function Unsafe failing its 
Postcondition.

If the Task_Safe attribute existed, the compiler could have issued a 
warning at compile time that the tasks were calling subprograms that 
weren't Task_Safe, and the problems could have been avoided.


with Ada.Text_IO; use Ada.Text_IO;
with Ada.Exceptions; use Ada;
with Ada.Command_Line;

procedure Test_Task_Safety is

    --  Defaults to 1_000_000, but can be specified on command line
    N : constant Natural := (if Command_Line.Argument_Count >= 1 then
                             Natural'Value (Command_Line.Argument (1))
                             else 1_000_000);

    Global_Data : Integer := 0;

    function Unsafe (X : Natural) return Natural
        with Post => Unsafe'Result = X + 1 --,
         --  Task_Safe => False
        ;

    function Unsafe (X : Natural) return Natural is
    begin
       Global_Data := X;
       Global_Data := Global_Data + 1;
       return Global_Data;
    end Unsafe;

begin

    New_Line;
    Put_Line ("******************************** ");
    Put_Line ("****  Test1 : Unsafe calls ***** ");
    Put_Line ("******************************** ");
    New_Line;

    Test1 : declare

       task type T1 is
       end T1;

       task body T1 is
          Result : Natural := 0;
       begin
          for I in 1 .. N loop
             Result := Unsafe (Result);
          end loop;
          Put_Line ("Result =" & Natural'Image (Result));
       exception
          when E : others =>
             Put_Line ("Task_Died" & 
Ada.Exceptions.Exception_Information (E));
       end T1;

       Workers : array (1 .. 10) of T1;
    begin
       null;
    end Test1;

    New_Line;
    Put_Line ("********************************************************");
    Put_Line ("****  Test2 : Unsafe calls from protected objects ***** ");
    Put_Line ("********************************************************");
    New_Line;

    Test2 : declare

       protected PO1 is
          function Foo (X : Natural) return Natural;
       end PO1;

       protected PO2 is
          function Bar (X : Natural) return Natural;
       end PO2;

       protected body PO1 is
          function Foo (X : Natural) return Natural is
          begin
             return Unsafe (X);
          end Foo;
       end PO1;

       protected body PO2 is
          function Bar (X : Natural) return Natural is
          begin
             return Unsafe (X);
          end Bar;
       end PO2;

       task type T1 is
       end T1;

       task body T1 is
          Result : Natural := 0;
       begin
          for I in 1 .. N loop
             Result := PO1.Foo (Result);
          end loop;
          Put_Line ("Result =" & Natural'Image (Result));
       exception
          when E : others =>
             Put_Line ("Task_Died" & 
Ada.Exceptions.Exception_Information (E));
       end T1;

       task type T2 is
       end T2;

       task body T2 is
          Result : Natural := 0;
       begin
          for I in 1 .. N loop
             Result := PO2.Bar (Result);
          end loop;
          Put_Line ("Result =" & Natural'Image (Result));
       exception
          when E : others =>
             Put_Line ("Task_Died" & 
Ada.Exceptions.Exception_Information (E));
       end T2;

       Foo_Workers : array (1 .. 10) of T1;
       Bar_Workers : array (1 .. 10) of T2;

    begin
       null;
    end Test2;

    null;
end Test_Task_Safety;

Output:

********************************
****  Test1 : Unsafe calls *****
********************************

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Result = 1000000

********************************************************
****  Test2 : Unsafe calls from protected objects *****
********************************************************

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Task_DiedException name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed postcondition from test_task_safety.adb:15

Result = 1000000

Brad
>
> There is no reasonable rules to verify. Safety of an operation is *not*
> related to the safety of called operations, not transitive nor
> antitransitive.
>

^ permalink raw reply	[relevance 5%]

* Re: Augusta: An open source Ada 2012 compiler (someday?)
  @ 2014-03-28  8:56  7%                     ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2014-03-28  8:56 UTC (permalink / raw)


On Thu, 27 Mar 2014 13:38:16 -0700 (PDT), Lucretia wrote:

> i.e. 1) add exception records
> 
> type E is exception
>    record
>       My_Data : Integer;
>    end record;

You will have a problem catching such exceptions because in Ada exceptions
are "values" not "types", like in C++.

That they are "value" among other allows enumeration like:

   when Error : Constraint_Error | Data_Error =>

If Constraint_Error and Data_Error were "types" what would be the type of
Error? You could move to classes of exceptions but that still would not
allow simple enumerations when instances are not siblings.

A related problem is renaming of exceptions. A renaming produce a new
object, but you still can catch it under original name because the result
has same "value."

In general if exceptions form a tree of related types you have a problem of
choosing between sets, possibly nested sets of types in exception handlers.
C++ does this by linear matching exceptions in the order they appear. This
is a mess.

> 2) User defined types having 'Image and 'Value, which call a subprogram
> which must be defined if these attributes are to be used - much like the
> stream operations do.

They should be primitive operations instead.

But the actual problem here is MD. It works with stream attributes through
cascaded dispatch *only* because streams enforce Stream_Element on all
implementations which decompose objects into Stream_Element_Arrays. This is
the reason why a stream attribute can *first* dispatch on the object type
and *then* on the stream. For 'Image and 'Value it would not work in
presence of Character, Wide_Character, Wide_Wide_Character. That is full
MD, or else you have to restrict it to single character type.
 
> 3) Replace tagged with just class, so:
> 
> type C is
>    class
>       ...
>    end class;

Class is not a type. Class is a set of types. A class can have a
"representative" type, which is already named in Ada as T'Class.

In short, you need not to specify that some type may be member of a class.
All types may. Why not?

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 7%]

* Re: Generating an XML DOM tree from scratch withXML/Ada 2013
  @ 2014-03-21 16:12  5% ` J Kimball
  0 siblings, 0 replies; 200+ results
From: J Kimball @ 2014-03-21 16:12 UTC (permalink / raw)


On 03/20/2014 12:00 PM, Marc C wrote:
> After writing up some pathfinding code to simply create a DOM document tree from scratch, add a node, and write it out, I was perplexed that the namespace data I was supplying was not showing up in the document.
>
> Imagine my surprise when looking at the Dom.Core.Create_Document() implementation and seeing that the Namespace_URI (and Qualified_Name) parameters are simply ignored. The comment in the spec simply states "Note that Namespace_URI can be the empty string if you do not want to use namespaces."
>
> Well, I *do* want (and need) to use namespaces.
>
> The implementation of various subprograms reference namespaces and qualified names, and that seems to somehow tie into the SAX Symbol_Table that can be provided to Create_Document.  But it ain't clear what one would have to do in that regard, not to mention I'm not sure I'm even reading the code right about all that.
>
> I've got XML_EZ_Out for outputting XML, but in this instance I preferred to build the DOM tree and manipulate it, then write the whole thing out when I was done.
>
> Anyone used the GNAT GPL 2013 XML/Ada packages for creating DOM trees with namespaces?
>
> Thanks.
>
> Marc A. Criley
>

I have done this. The organization and documentation of XML is perplexing and I've also spent hours banging my head against a wall trying to use namespaces and validation.

Here's a result of my labor. I hope you can make some sense of it. Unfortunately, I couldn't find the input files that i was using to test.

There are two command line arguments. I think the first is the xml file and the second is a valid XSD schema.

Good luck.

--

with Ada.Command_Line;
with Ada.Directories;
with Ada.Direct_IO;
with Ada.Exceptions;
with Ada.Text_IO;

with DOM.Core.Elements;
with DOM.Core.Nodes;
with Input_Sources.File;
with Input_Sources.Strings;
with SAX.Readers;
with Schema.DOM_Readers;
with Schema.Schema_Readers;
with Schema.Validators;
with Unicode.CES.Utf8;

procedure Validate_Message is
    Grammar : Schema.Validators.XML_Grammar;

    Agent_NS : String := "http://example.com/schemas/agent";

    function Get_Message (XML : String) return String is
       Input    : Input_Sources.Strings.String_Input;
       Reader   : Schema.DOM_Readers.Tree_Reader;
       Document : DOM.Core.Document;

       Elements : DOM.Core.Node_List;
    begin
       Input_Sources.Strings.Open (Str => XML, Encoding => Unicode.CES.Utf8.Utf8_Encoding, Input => Input);

       Schema.DOM_Readers.Set_Grammar (Reader, Grammar);

       Schema.DOM_Readers.Set_Feature (Reader, SAX.Readers.Namespace_Prefixes_Feature, True);
       Schema.DOM_Readers.Set_Feature (Reader, SAX.Readers.Namespace_Feature, True);
--      Schema.DOM_Readers.Set_Feature (Reader, SAX.Readers.Validation_Feature, True);

       Schema.DOM_Readers.Parse (Reader, Input);
       Input_Sources.Strings.Close (Input);

       Document := Schema.DOM_Readers.Get_Tree (Reader);

       Schema.DOM_Readers.Free (Reader);

       Elements := DOM.Core.Elements.Get_Elements_By_Tag_Name_NS (Elem => Document, Namespace_URI => Agent_NS, Local_Name => "message");

       return DOM.Core.Nodes.Node_Value (DOM.Core.Nodes.Item (Elements, 0) );
    exception
       when E : others =>
          Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E) );

          raise;
    end Get_Message;

    function Init_Grammar return Schema.Validators.XML_Grammar is
       Reader : Schema.Schema_Readers.Schema_Reader;
       Input  : Input_Sources.File.File_Input;
    begin
       Input_Sources.File.Open (Ada.Command_Line.Argument (2), Input);
       Schema.Schema_Readers.Parse (Reader, Input);
       Input_Sources.File.Close (Input);

       return Schema.Schema_Readers.Get_Grammar (Reader);
    end Init_Grammar;

    File_Size : Ada.Directories.File_Size := Ada.Directories.Size (Ada.Command_Line.Argument (1) );
    subtype File_Input is String (1..Integer (File_Size) );

    package File_IO is new Ada.Direct_IO (Element_Type => File_Input);

    File  : File_IO.File_Type;

    Input : File_Input;
begin
    Schema.Set_Debug_Output (True);
--   Schema.Dump_Internal_XSD := True;

    File_IO.Open (File => File, Mode => File_IO.In_File, Name => Ada.Command_Line.Argument (1) );
    File_IO.Read (File => File, Item => Input);
    File_IO.Close (File => File);

    Grammar := Init_Grammar;

    Ada.Text_IO.Put_Line (Get_Message (Input) );
end Validate_Message;

^ permalink raw reply	[relevance 5%]

* Class Wide Type Invariants - My bug or compiler bug
@ 2014-02-26  3:29  5% Anh Vo
  0 siblings, 0 replies; 200+ results
From: Anh Vo @ 2014-02-26  3:29 UTC (permalink / raw)


GNAT did not raise Assertion_Error where I thought it should for the following codes. Either I misunderstood the LRM or it is a compiler bug.

-- places.ads
package Places is

   type Disc_Pt is tagged private
     with Type_Invariant'Class => Check_In (Disc_Pt);

   Initial_Disc_Pt : constant Disc_Pt;

   function Check_In (D : Disc_Pt) return Boolean with Inline;
   
   procedure Set_X_Coord (D : in out Disc_Pt; X : Float)
      with Pre => (X >= -1.0 and then X <= 1.0);

   procedure Set_Y_Coord (D : in out Disc_Pt; Y : Float)
      with Pre => (Y >= -1.0 and then Y <= 1.0);

private
   type Disc_Pt is tagged
      record
         X, Y : Float range -1.0 .. +1.0;
      end record;

   Initial_Disc_Pt : constant Disc_Pt := (others => 0.5);

end Places;

-- places.adb
package body Places is

     function Check_In (D : Disc_Pt) return Boolean is
     begin
        return (D.X**2 + D.Y**2 <= 1.0);
     end Check_In;
     
   procedure Set_X_Coord (D : in out Disc_Pt; X : Float) is
   begin
      D.X := X;
   end Set_X_Coord;

   procedure Set_Y_Coord (D : in out Disc_Pt; Y : Float) is
   begin
      D.Y := Y;
   end Set_Y_Coord;

end Places;

-- places.inner.ads
package Places.Inner is
   
   type Ring_Pt is new Disc_Pt with private
      with Type_Invariant'Class => Check_Out(Ring_Pt);
   Initial_Ring_Pt : constant Ring_Pt;

   function Check_Out (R : Ring_Pt) return Boolean
     with Inline;

private
   type Ring_Pt is new Disc_Pt with null record;

   Initial_Ring_Pt : constant Ring_Pt := Ring_Pt'(Initial_Disc_Pt with null record);

   function Check_Out (R : Ring_Pt) return Boolean is
     (R.X**2 + R.Y**2 >= 0.25);

end Places.Inner;


-- invariants_inheritance_test.adb
with Ada.Text_Io;
with Ada.Exceptions; use Ada;

with Places.Inner;

procedure Invariants_Inheritance_Test is
   use Text_Io;

   Child_Pt : Places.Inner.Ring_Pt := Places.Inner.Initial_Ring_Pt;

begin

   Places.Inner.Set_X_Coord(Child_Pt, 0.0);  -- OK since 0.5**2 + 0.0 >= 0.25
   Places.Inner.Set_Y_Coord(Child_Pt, 0.1);  -- should fail Check_Out(...), 
                                             -- 0.1**2 + 0.0 < 0.25
exception
   when Err : others =>
      Put_Line ("Houston help!!! " & Exceptions.Exception_Information(Err));

end Invariants_Inheritance_Test;


^ permalink raw reply	[relevance 5%]

* Re: confusing string error
  2014-02-15 18:29  5%           ` Simon Wright
@ 2014-02-17 12:57  0%             ` agent
  0 siblings, 0 replies; 200+ results
From: agent @ 2014-02-17 12:57 UTC (permalink / raw)


On Sat, 15 Feb 2014 18:29:29 +0000, Simon Wright <simon@pushface.org>
wrote:

>adambeneschan@gmail.com writes:
>
>> On Saturday, February 15, 2014 4:53:42 AM UTC-8, ag...@drrob1.com wrote:
>>> On Sat, 15 Feb 2014 09:33:25 +0000, Simon Wright wrote:
>>
>>> I guess this is a case of the error code does not match the error.  I
>>> kept getting an error message about the character appending line.
>>> 
>>> I tried GDB and stepped through, and seemed to get the same error.
>
>GNAT/GDB finds it correctly for me;
>
>   (gdb) catch exception
>   Catchpoint 1: all Ada exceptions
>   (gdb) run
>   Starting program: /Users/simon/tmp/testtokenizea 
>    Input line : 1+
>
>    Number of characters read is           2.  Value of s'last is         2561, token.state = DGT, sum=          1, DELIMCH= +, DELIMSTATE= OP
>
>   Catchpoint 1, ADA.STRINGS.INDEX_ERROR at 0x0000000100001cdb in tokenizea__getopcode (token=...) at tokenizea.adb:121
>   121	      CH2 := Element(Token.UStr,2);

I'll have to use the catch command in the future, now that you have
taught it to me.

Thanks
--rob


^ permalink raw reply	[relevance 0%]

* Re: confusing string error
  @ 2014-02-15 18:29  5%           ` Simon Wright
  2014-02-17 12:57  0%             ` agent
  0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2014-02-15 18:29 UTC (permalink / raw)


adambeneschan@gmail.com writes:

> On Saturday, February 15, 2014 4:53:42 AM UTC-8, ag...@drrob1.com wrote:
>> On Sat, 15 Feb 2014 09:33:25 +0000, Simon Wright wrote:
>
>> I guess this is a case of the error code does not match the error.  I
>> kept getting an error message about the character appending line.
>> 
>> I tried GDB and stepped through, and seemed to get the same error.
>
> Sometimes the Put_Line debugger does a better job than other debuggers.
>
>
>> I still don't understand why stepping line by line did not show me the
>> correct failure point.
>
> I don't have a way to tell.  (I found out what line it was because I
> tried it using Irvine Compiler's debugger, which did tell me what the
> correct line was.)  There are some possible reasons that I can think
> of why incorrect lines might show up (based on my general experience,
> not on any particular knowledge of GNAT/GDB).  The source files could
> just be out of sync; e.g. you edited a file to add some comments but
> didn't recompile it, or you linked using an object file from the wrong
> place.  If your source was in one large file, and GNATCHOP was called
> on to split it up, the line may refer to the larger file rather than
> the split-up one or vice versa.  Finally, optimization can cause
> problems when the compiler rearranges code; it can be very difficult
> to get it to display correct line numbers.  Plus we can't rule out a
> compiler bug.

GNAT/GDB finds it correctly for me;

   (gdb) catch exception
   Catchpoint 1: all Ada exceptions
   (gdb) run
   Starting program: /Users/simon/tmp/testtokenizea 
    Input line : 1+

    Number of characters read is           2.  Value of s'last is         2561, token.state = DGT, sum=          1, DELIMCH= +, DELIMSTATE= OP

   Catchpoint 1, ADA.STRINGS.INDEX_ERROR at 0x0000000100001cdb in tokenizea__getopcode (token=...) at tokenizea.adb:121
   121	      CH2 := Element(Token.UStr,2);


^ permalink raw reply	[relevance 5%]

* Re: 4 beginner's questions on the PL Ada
  2013-08-12 19:57  0%                 ` Simon Wright
@ 2013-08-12 20:13  0%                   ` Anh Vo
  0 siblings, 0 replies; 200+ results
From: Anh Vo @ 2013-08-12 20:13 UTC (permalink / raw)


On Monday, August 12, 2013 12:57:49 PM UTC-7, Simon Wright wrote:
> Anh Vo <anhvofrcaus@gmail.com> writes:
>  
> > Here is how a task name is consistently implemented across different 
> > compilers.
>  
> ? I think not, because ...
>  
> > with Ada.Exceptions; 
> > with Ada.Text_Io;  
> > with Ada.Task_Attributes; 
> > with Ada.Task_Identification; 
> > with GNAT.Traceback.Symbolic;
> 
>        ^^^^                       <<<<< this! 

It is true that GNAT and its children packages are not portable. GNAT.Traceback.Symbolic package is actually not needed for task name testing purposes.

^ permalink raw reply	[relevance 0%]

* Re: 4 beginner's questions on the PL Ada
  2013-08-12 17:39  5%               ` Anh Vo
@ 2013-08-12 19:57  0%                 ` Simon Wright
  2013-08-12 20:13  0%                   ` Anh Vo
  0 siblings, 1 reply; 200+ results
From: Simon Wright @ 2013-08-12 19:57 UTC (permalink / raw)


Anh Vo <anhvofrcaus@gmail.com> writes:

> Here is how a task name is consistently implemented across different
> compilers.

? I think not, because ...

> with Ada.Exceptions;
> with Ada.Text_Io; 
> with Ada.Task_Attributes;
> with Ada.Task_Identification;
> with GNAT.Traceback.Symbolic;
       ^^^^                       <<<<< this!
> use Ada;
>
> procedure Task_Name_Test is

^ permalink raw reply	[relevance 0%]

* Re: 4 beginner's questions on the PL Ada
  @ 2013-08-12 17:39  5%               ` Anh Vo
  2013-08-12 19:57  0%                 ` Simon Wright
  0 siblings, 1 reply; 200+ results
From: Anh Vo @ 2013-08-12 17:39 UTC (permalink / raw)


On Friday, August 9, 2013 6:24:13 PM UTC-7, Emanuel Berg wrote:
> Anh Vo <anhvofrcaus@gmail.com> writes:
>  
> You guys should do a field trip to gnu.emacs.help - there, we just 
> post code all days! It is much better. Code speaks louder than 
> words. It is very difficult to follow all this discussion on 
> memory allocation etc., but the few times you posted code there 
> wasn't a letter I didn't understand immediately.
>  
> And isn't that the same way with you? If you were to explain the C 
> for loop to another programmer, would you not just write
>  
> for (i = 0; i < STOP; i++) { printf("Pretty clear, huh?\n"); }
>  
> But I don't doubt your Ada knowledge, or you helpful attitude.

Hmmmm... These have nothing to do with how a task name implemented with respect to portability.
 
>> You can give/assign a name to a task the way you like by using
>> predefined package Ada.Task_Attributes. In this case you most
>> likely instantiate it with String subtype. Therefore, it is will
>> be completely portable.
>  
> And (drumroll...) how would that look?
 
Here is how a task name is consistently implemented across different compilers. By the way, this is a complete running program.

with Ada.Exceptions;
with Ada.Text_Io; 
with Ada.Task_Attributes;
with Ada.Task_Identification;
with GNAT.Traceback.Symbolic;
use Ada;

procedure Task_Name_Test is
   use Text_Io;
   
   type Name is access String;
   Default_Name : constant Name := new String'("Generic task name");
   
   Package Task_Manager is new Task_Attributes (Name, Default_Name);
   
   task Gentleman is
      entry Hello;
      entry Goodbye;
   end Gentleman;
   
   task body Gentleman is
   begin
      accept Hello;
      Put_Line ("My name is " & 
                   Task_Manager.Value (Task_Identification.Current_Task).all &
                  ". It's my pleasure to meeting you");
      accept Goodbye;
      Put_Line ("Hopefully, we will meet again in the future.");
   end Gentleman;

   Gentleman_Name : Name := new String'("Gentleman");
      
begin
   Put_Line ("Task_Name_Test starts");

   Task_Manager.Set_Value (Val => Gentleman_Name, T => Gentleman'Identity);
   
   Gentleman.Hello;
   Gentleman.Goodbye;

   Put_Line ("Task_Name_Test starts");
   
exception
   when Err : others =>
      Put_Line (Exceptions.Exception_Name(Err) & " was raised");
      Put_Line (GNAT.Traceback.Symbolic.Symbolic_Traceback(Err));
end Task_Name_Test;


Once again, it is about task name. If it is not, it should not belong here.

Anh Vo.

^ permalink raw reply	[relevance 5%]

* Re: Ada exception vulnerability?
  2013-07-30 14:45  5% Ada exception vulnerability? Diogenes
@ 2013-07-30 21:30  5% ` erlo
  0 siblings, 0 replies; 200+ results
From: erlo @ 2013-07-30 21:30 UTC (permalink / raw)


On 07/30/2013 04:45 PM, Diogenes wrote:
> I'm reading the paper at http://mirror.die.net/misc/defcon-20/speaker%20presentations/branco-oakley-bratus/rodrigobranco.txt
>
> Does anyone know if GNAT/Ada exceptions on Linux are currently vulnerable to this attack?
>
> Diogenes
>
By the looks of the output from readelf, I would think so:

erlo@beeblebrox:~/Proj/Ada/Exception_test/obj$ readelf -S main
There are 31 section headers, starting at offset 0x2208:

Section Headers:
   [Nr] Name              Type            Addr     Off    Size   ES Flg 
Lk Inf Al
   [ 0]                   NULL            00000000 000000 000000 00 
  0   0  0
   [ 1] .interp           PROGBITS        08048154 000154 000013 00   A 
  0   0  1
   [ 2] .note.ABI-tag     NOTE            08048168 000168 000020 00   A 
  0   0  4
   [ 3] .note.gnu.build-i NOTE            08048188 000188 000024 00   A 
  0   0  4
   [ 4] .gnu.hash         GNU_HASH        080481ac 0001ac 00017c 04   A 
  5   0  4
   [ 5] .dynsym           DYNSYM          08048328 000328 000500 10   A 
  6   1  4
   [ 6] .dynstr           STRTAB          08048828 000828 000759 00   A 
  0   0  1
   [ 7] .gnu.version      VERSYM          08048f82 000f82 0000a0 02   A 
  5   0  2
   [ 8] .gnu.version_r    VERNEED         08049024 001024 000040 00   A 
  6   2  4
   [ 9] .rel.dyn          REL             08049064 001064 000140 08   A 
  5   0  4
   [10] .rel.plt          REL             080491a4 0011a4 000108 08   A 
  5  12  4
   [11] .init             PROGBITS        080492ac 0012ac 00002e 00  AX 
  0   0  4
   [12] .plt              PROGBITS        080492e0 0012e0 000220 04  AX 
  0   0 16
   [13] .text             PROGBITS        08049500 001500 00050c 00  AX 
  0   0 16
   [14] .fini             PROGBITS        08049a0c 001a0c 00001a 00  AX 
  0   0  4
   [15] .rodata           PROGBITS        08049a28 001a28 0001c2 00   A 
  0   0  4
   [16] .eh_frame_hdr     PROGBITS        08049bec 001bec 00004c 00   A 
  0   0  4
   [17] .eh_frame         PROGBITS        08049c38 001c38 000160 00   A 
  0   0  4
   [18] .gcc_except_table PROGBITS        08049d98 001d98 000024 00   A 
  0   0  4
   [19] .ctors            PROGBITS        0804af04 001f04 000008 00  WA 
  0   0  4
   [20] .dtors            PROGBITS        0804af0c 001f0c 000008 00  WA 
  0   0  4
   [21] .jcr              PROGBITS        0804af14 001f14 000004 00  WA 
  0   0  4
   [22] .dynamic          DYNAMIC         0804af18 001f18 0000d8 08  WA 
  6   0  4
   [23] .got              PROGBITS        0804aff0 001ff0 000004 04  WA 
  0   0  4
   [24] .got.plt          PROGBITS        0804aff4 001ff4 000090 04  WA 
  0   0  4
   [25] .data             PROGBITS        0804b084 002084 000028 00  WA 
  0   0  4
   [26] .bss              NOBITS          0804b0c0 0020ac 0001e4 00  WA 
  0   0 32
   [27] .comment          PROGBITS        00000000 0020ac 00004d 01  MS 
  0   0  1
   [28] .shstrtab         STRTAB          00000000 0020f9 00010e 00 
  0   0  1
   [29] .symtab           SYMTAB          00000000 0026e0 000e70 10 
30  52  4
   [30] .strtab           STRTAB          00000000 003550 001048 00 
  0   0  1
Key to Flags:
   W (write), A (alloc), X (execute), M (merge), S (strings)
   I (info), L (link order), G (group), T (TLS), E (exclude), x (unknown)
   O (extra OS processing required) o (OS specific), p (processor specific)


erlo@beeblebrox:~/Proj/Ada/Exception_test/obj$ readelf 
--debug-dump=frames main
Contents of the .eh_frame section:

00000000 00000014 00000000 CIE
   Version:               1
   Augmentation:          "zR"
   Code alignment factor: 1
   Data alignment factor: -4
   Return address column: 8
   Augmentation data:     1b

   DW_CFA_def_cfa: r4 (esp) ofs 4
   DW_CFA_offset: r8 (eip) at cfa-4
   DW_CFA_nop
   DW_CFA_nop
... and much more to follow.

The Ada source looks like this:

with Ada.Text_IO;
with Ada.Exceptions;

use Ada.Exceptions;

procedure Main is

My_Exception : exception;

begin
    Ada.Text_IO.Put_Line("Howdy");
    raise My_Exception;
    exception
       when My_Exception =>
          Ada.Text_IO.Put_Line("Caught exception");
end Main;

The program is built with gnat 4.6:
erlo@beeblebrox:~/Proj/Ada/Exception_test/src$ gnat
GNAT 4.6
Copyright 1996-2010, Free Software Foundation, Inc.

Best regards
Erlo


^ permalink raw reply	[relevance 5%]

* Ada exception vulnerability?
@ 2013-07-30 14:45  5% Diogenes
  2013-07-30 21:30  5% ` erlo
  0 siblings, 1 reply; 200+ results
From: Diogenes @ 2013-07-30 14:45 UTC (permalink / raw)


I'm reading the paper at http://mirror.die.net/misc/defcon-20/speaker%20presentations/branco-oakley-bratus/rodrigobranco.txt

Does anyone know if GNAT/Ada exceptions on Linux are currently vulnerable to this attack?

Diogenes

^ permalink raw reply	[relevance 5%]

* Re: GCC 4.8.1 for Mac OS X
  @ 2013-07-17 21:00  6%   ` Simon Wright
  0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2013-07-17 21:00 UTC (permalink / raw)


Felix Krause <flyx@isobeef.org> writes:

> On 2013-07-07 18:37:02 +0000, Simon Wright said:
>
>> Tools included: ASIS, AUnit, GPRbuild, GNATColl, XMLAda from GNAT GPL
>> 2013.
>
> Just noticed that there is no gdb included. Would be great to have
> that. It does't seem to be possible to use the gdb from Apple, it
> doesn't recognize things like "break exception". I am rather unsure
> about how language support is compiled into gdb and how one would
> compile a gdb that supports Ada.

The system gdb is 6.3, and as you say doesn't understand Ada (BTW, the
current usage is 'catch exception', not 'break exception').

GDB 7.6 builds with the GCC 4.8.1 I uploaded, with very little
configuration needed (or possible):

   ../gdb-7.6/configure \
      --prefix=/opt/gcc-4.8.1 \
      --build=x86_64-apple-darwin12

but the resulting GDB isn't without its problems --

   * it needs to be code-signed (but you can run it as root)

   * it needs to be kicked to realise that it can catch Ada exceptions,
     just like in [1]

   * it gets confused about exceptions, but seems to stumble its way
     through eventually

   * it doesn't demangle Ada subprogram names properly

-- see [2].

I used to use the GDB that comes with GNAT GPL, but I see that the GPL
2013 version has exactly the same problems I noted above! Bug report
required, I think.

[1]
http://forward-in-code.blogspot.co.uk/2012/01/catching-exceptions-in-gdb.html

[2]
(gdb) catch exception name_error
Your Ada runtime appears to be missing some debugging information.
Cannot insert Ada exception catchpoint in this configuration.
(gdb) print __gnat_debug_raise_exception
$1 = {<text variable, no debug info>} 0x10017d4dd <__gnat_debug_raise_exception>
(gdb) catch exception name_error
warning: failed to reevaluate internal exception condition for catchpoint 0: A syntax error in expression, near `e) = long_integer (&name_error)'.
Catchpoint 1: `name_error' Ada exception
(gdb) run foo.uml
Starting program: /Users/simon/coldframe/tools/normalize_xmi foo.uml
warning: failed to reevaluate internal exception condition for catchpoint 1: A syntax error in expression, near `e) = long_integer (&name_error)'.
warning: failed to reevaluate internal exception condition for catchpoint 1: A syntax error in expression, near `e) = long_integer (&name_error)'.
processing foo.uml

Catchpoint 1, ADA.IO_EXCEPTIONS.NAME_ERROR at 0x000000010009b5f7 in _ada_normalize_xmi__main () at /Users/simon/coldframe/tools/normalize_xmi-main.adb:90
90	            Input_Sources.File.Open (Arg, File_Source);
(gdb) 


^ permalink raw reply	[relevance 6%]

* Re: Seeking for papers about tagged types vs access to subprograms
  2013-05-06 15:15  6%               ` Yannick Duchêne (Hibou57)
@ 2013-05-06 18:55  0%                 ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2013-05-06 18:55 UTC (permalink / raw)


On Mon, 06 May 2013 17:15:36 +0200, Yannick Duchêne (Hibou57) wrote:

> Le Mon, 06 May 2013 16:16:02 +0200, Dmitry A. Kazakov  
> <mailbox@dmitry-kazakov.de> a écrit:
>>> Theoretically. In practice, GNAT don't agree (*). It has a pragma for
>>> that, `pragma Restrictions (No_Dispatching_Calls)` which should even
>>> enforce it in a whole application, but seems even with this active, it
>>> still requires the whole part of the runtime dedicated to it, a part  
>>> which depends on this part,
>>
>> I suppose it would be difficult to implement this so that the code used to
>> maintain dispatching tables and tags could be removed. It may require two
>> versions of the compiler. Furthermore there are packages defining
>> operations on tags which could require some of the stuff.
>>
>> Why do you bother? Especially, because dispatching calls are deterministic
>> and could be done time bounded, unless you manipulate tags. (Not everything
>> in people write in their guidelines for RT projects makes sense.)
> 
> That's not real‑time, that's just saving dependencies (have to be static)  
> and memory (static linking easily make it big) and to be sure to know  
> what's running beneath (no implicit heap allocation, no secondary stack,  
> bounded stack, no output to standard I/O streams except if the program do  
> it explicitly, and so on).

I don't see how dispatching calls could be relevant to these constraints
which apply to both dispatching and specific calls. Dispatching call is a
bogeyman under the bed.

> Initially I just wanted to get ride of function  
> returning unconstrained types and the exceptions runtime (I don't like  
> exceptions used to return the status of an operation anyway) and keep only  
> the last‑chance handler, but it appears the high level parts of the  
> runtime depends on the exceptions support (ex. direct or indirect  
> dependencies to Ada.Exceptions and al.).

Instead of banishing exceptions one should put contracts on them.

>>> However and in the large, I
>>> agree with you and share the same understanding of the topic, at least
>>> theoretically.
>>
>> There are far reaching consequences of having classes for all types.
> 
> Interfaces for all types :-D

Yes, this is more or less same as having classes.
 
>> What is in the interface cannot be decided before you have
>> interfaces properly articulated. Thus type system overhaul is the first
>> step to make.
> 
> Saying “overhaul”, you will always get this reply: “no way, don't break  
> compatibility” (something which in the meanwhile is easily understood).

Usual hand waving used by people who don't want to discuss it seriously.
And they do not.

> May be there would be a hope to do something similar to what SPARK did,  
> just with bigger consequences, re‑factoring Ada outside of Ada (which is  
> unavoidable to go ahead without fears to break compatibility).

I thought about it, but this is far larger than one-man project and there
is too much things which nobody did before and nobody knows how to do.
Before doing this one should clearly understand it, and before
understanding it there should be a serious discussion about it. And before
that starts there should be a desire in the community to fix the language,
which is clearly absent. Ada 2012 became a patchwork under which one can
barely see its original ideas.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de

^ permalink raw reply	[relevance 0%]

* Re: Seeking for papers about tagged types vs access to subprograms
  @ 2013-05-06 15:15  6%               ` Yannick Duchêne (Hibou57)
  2013-05-06 18:55  0%                 ` Dmitry A. Kazakov
  0 siblings, 1 reply; 200+ results
From: Yannick Duchêne (Hibou57) @ 2013-05-06 15:15 UTC (permalink / raw)


Le Mon, 06 May 2013 16:16:02 +0200, Dmitry A. Kazakov  
<mailbox@dmitry-kazakov.de> a écrit:
>> Theoretically. In practice, GNAT don't agree (*). It has a pragma for
>> that, `pragma Restrictions (No_Dispatching_Calls)` which should even
>> enforce it in a whole application, but seems even with this active, it
>> still requires the whole part of the runtime dedicated to it, a part  
>> which
>> depends on this part,
>
> I suppose it would be difficult to implement this so that the code used  
> to
> maintain dispatching tables and tags could be removed. It may require two
> versions of the compiler. Furthermore there are packages defining
> operations on tags which could require some of the stuff.
>
> Why do you bother? Especially, because dispatching calls are  
> deterministic
> and could be done time bounded, unless you manipulate tags. (Not  
> everything
> in people write in their guidelines for RT projects makes sense.)

That's not real‑time, that's just saving dependencies (have to be static)  
and memory (static linking easily make it big) and to be sure to know  
what's running beneath (no implicit heap allocation, no secondary stack,  
bounded stack, no output to standard I/O streams except if the program do  
it explicitly, and so on). Initially I just wanted to get ride of function  
returning unconstrained types and the exceptions runtime (I don't like  
exceptions used to return the status of an operation anyway) and keep only  
the last‑chance handler, but it appears the high level parts of the  
runtime depends on the exceptions support (ex. direct or indirect  
dependencies to Ada.Exceptions and al.). There is surely a way to get ride  
of exceptions without loosing all of the rest in the while, but I don't  
want to spend time diving in the runtime nor want to make uncertain/unsafe  
modifications, I have something else to do which can be done without  
tagging types (at the cost of some useful facilities like  
initialization/finalization).

>> However and in the large, I
>> agree with you and share the same understanding of the topic, at least
>> theoretically.
>
> There are far reaching consequences of having classes for all types.

Interfaces for all types :-D

>> (*) Don't know if SPARK agree and believe something can be proved about
>> such a system, it's a too long time I didn't use it. A quick search on  
>> the
>> web seems to show it may be possible.
>
> Yes, through global analysis. Though I would prefer a much finer approach
> when time constraints could be imposed on the interface rather than  
> checked afterwards.

SPARK is often said to be used for application with time and memory bounds  
requirement, but I don't know any way to prove timing bounds in SPARK.

> What is in the interface cannot be decided before you have
> interfaces properly articulated. Thus type system overhaul is the first
> step to make.

Saying “overhaul”, you will always get this reply: “no way, don't break  
compatibility” (something which in the meanwhile is easily understood).  
May be there would be a hope to do something similar to what SPARK did,  
just with bigger consequences, re‑factoring Ada outside of Ada (which is  
unavoidable to go ahead without fears to break compatibility).

> Without doing that you get only mess.
> See Ada 2012 dynamic
> pre-/postconditions as an example.

I did not encountered any real mess so far with dynamic pre/post  
condition. The only grief I have with it, is that it makes no distinction  
between sub‑program used for pre/post conditions and sub‑programs used for  
the program. Occasionally, that may lead to contradictions or impossible  
design. I would like a way to permit to restrict some sub‑programs for use  
with pre/post conditions only and disallow their use from the program  
proper (just like you have to separate meta‑language and object‑language,  
even when both shares the same vocabulary and grammar). At least, and  
external language like SPARK annotations is, does not suffers from this  
confusion: a predicate may be expressed in terms of Ada entities, but is  
not imposed to be entirely expressed in these terms and never injects  
anything into the program (sorry for digressing (red‑face)).


-- 
“Syntactic sugar causes cancer of the semi-colons.” [1]
“Structured Programming supports the law of the excluded muddle.” [1]
[1]: Epigrams on Programming — Alan J. — P. Yale University


^ permalink raw reply	[relevance 6%]

* Gnat Version 4.5.4 v protected objects v tasking
@ 2013-04-23 20:30  4% stvcook53
  0 siblings, 0 replies; 200+ results
From: stvcook53 @ 2013-04-23 20:30 UTC (permalink / raw)


Please consider sample code and comment to remedy failure in code sample or compiler.

Tried several versions of GPL Gnat Ada this year to build under x86_64 RHEL5 OS where previously succeeded with i386 OS.  Fortunately, the 4.5.4 libre gnat builds all my source code, but exhibits strange run-time symptoms using a sample that worked with older Gnat versions.  

Symptoms out of 4.5.4 relate to the tasking portion of the Ada run-time system, and relate to protected objects when located outside the main program.  Symptoms manifest as a silent hang when a program is run that includes the tasking portion of the runtime system.  The gdb debugger exhibits a SIGSEGV while in the run-time package System.Secondary_Stack.  Symptom occurs at the end of elaboration before control enters main program.  Please comment on sample code or planned, related Gnat updates.

Note: Internal compilation errors are common when trying to build my larger code using older Gnat versions in x86_64 configuration.  This includes 3.1.6, 4.1.0, and 4.3.6.  Emphasis on run-time in latest Gnat is derived from its success at building other code.

Sample code is summarized as follows:

main(Test_Protected_Object)
  with Contrived;

spec(Contrived)
body(Contrived) note: 3 types
    1. no tasking
    2. protected object
    3. task

Detailed code follows:
--main***
--Simple program to attempt to reproduce segmentation fault.

with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Command_Line;

with Contrived; -- add code actually involved in segmentation fault

procedure Test_Protected_Object is

begin  --Test_Protected_Object

   Ada.Text_IO.Put_Line("Test_Protected_Object: ");

   Ada.Text_IO.Put_Line("  The program name is "
                        & Ada.Command_Line.Command_Name);

   Ada.Text_IO.Put_Line("** before referencing protected object: ");
   Contrived.Print_This;
   Ada.Text_IO.Put_Line("*** after referencing protected object: ");

exception
 when E:others =>
   Ada.Text_IO.Put_Line("** unexpected exception "
                        & Ada.Exceptions.Exception_Name(E));
end Test_Protected_Object;

--spec(Contrived) ***
-------------------------------------------------------------------------------
-- Contrived package containing:
--   a.  no tasking
--   b.  a protected object
--   c.  a task
-- in the package body, depending upon which configuration I which to test.
-------------------------------------------------------------------------------

package Contrived is

   procedure Print_This;

end Contrived;

--body(Contrived - Option A no symptom) ***
-------------------------------------------------------------------------------
-- Contrived package containing:
--   a.  no tasking
--   b.  a protected object
--   c.  a task
-- in the package body, depending upon which configuration I which to test.
-------------------------------------------------------------------------------

-- this is configuration a.
with Ada.Text_IO;

package body Contrived is

   procedure Print_This is
   begin
      Ada.Text_IO.Put_Line("Contrived:  Print_This");
   end Print_This;

end Contrived;

--body(Contrived - Option B symptom) ***
-------------------------------------------------------------------------------
-- Contrived package containing:
--   a.  no tasking
--   b.  a protected object
--   c.  a task
-- in the package body, depending upon which configuration I which to test.
-------------------------------------------------------------------------------

-- this is configuration b.
with Ada.Text_IO;

package body Contrived is

   protected Object is
      procedure Print_That;
   end Object;

   protected body Object is
      procedure Print_That is
      begin
         Ada.Text_IO.Put_Line("Contrived.Object.Print_That");
      end Print_That;
   end Object;

   procedure Print_This is
   begin
      Ada.Text_IO.Put_Line("Contrived:  Print_This");
      Object.Print_That;
   end Print_This;

end Contrived;

--body(Contrived - Option C same symptom) ***
-------------------------------------------------------------------------------
-- Contrived package containing:
--   a.  no tasking
--   b.  a protected object
--   c.  a task
-- in the package body, depending upon which configuration I which to test.
-------------------------------------------------------------------------------

-- this is configuration c.
with Ada.Text_IO;

package body Contrived is

   task Object is
      entry Print_That;
   end Object;

   task body Object is
   begin
      loop
         select
            accept Print_That;
            Ada.Text_IO.Put_Line("Contrived.Object.Print_That");
         or
            terminate;
         end select;
      end loop;
   end Object;

   procedure Print_This is
   begin
      Ada.Text_IO.Put_Line("Contrived:  Print_This");
      Object.Print_That;
   end Print_This;

end Contrived;



^ permalink raw reply	[relevance 4%]

* Re: Extended Exceptions and other tweaks.
  2013-03-30 22:10  0% ` Brian Drummond
@ 2013-03-31 13:55  0%   ` Luke A. Guest
  0 siblings, 0 replies; 200+ results
From: Luke A. Guest @ 2013-03-31 13:55 UTC (permalink / raw)


Brian Drummond <brian@shapes.demon.co.uk> wrote:
> On Sat, 30 Mar 2013 13:01:51 -0700, Diogenes wrote:
> 
>> First of all...thanks to everyone who have given me pointers on my
>> initial runtime hacking experiments. I'm really trucking now.
>> 
>> Currently, just to gain some experience in this area, I building my own
>> runtime targeted to the Native platform, but using a much more rigorous
>> process. Using the Spark tools, unit testing everything, etc...
>> 
>> Since I'm working on the Ada Exceptions mechanism, I began to wonder if
>> it might not make sense to add security related exceptions as a possible
>> extension. I have ACLs going on one machine here, and of course Caps
>> going on others.
> 
> I can't comment on extended exceptions.
> 
> However, when supporting exceptions in his RTS, Luke apparently ran into 
> difficulties. If you have had more success - either using a different 
> approach, or following his but overcoming his difficulties, then that 

The problem I had was defining my own exceptions and raising them, i.e. I
could define but not raise, even though the bare machine runtime is
supposed to allow it, it doesn't and you need more mechanisms todo it.

Luke



^ permalink raw reply	[relevance 0%]

* Re: Extended Exceptions and other tweaks.
  2013-03-30 20:01  5% Extended Exceptions and other tweaks Diogenes
  2013-03-30 22:10  0% ` Brian Drummond
@ 2013-03-31 11:41  0% ` Stephen Leake
  1 sibling, 0 replies; 200+ results
From: Stephen Leake @ 2013-03-31 11:41 UTC (permalink / raw)


Diogenes <phathax0r@gmail.com> writes:

> First of all...thanks to everyone who have given me pointers on my
> initial runtime hacking experiments. I'm really trucking now.
>
> Currently, just to gain some experience in this area, I building my
> own runtime targeted to the Native platform, but using a much more
> rigorous process. Using the Spark tools, unit testing everything,
> etc...
>
> Since I'm working on the Ada Exceptions mechanism, I began to wonder
> if it might not make sense to add security related exceptions as a
> possible extension. I have ACLs going on one machine here, and of
> course Caps going on others.

I suggest that could be handled in current Ada; just add an appropriate
messsage to Use_Error.

-- 
-- Stephe



^ permalink raw reply	[relevance 0%]

* Re: Extended Exceptions and other tweaks.
  2013-03-30 20:01  5% Extended Exceptions and other tweaks Diogenes
@ 2013-03-30 22:10  0% ` Brian Drummond
  2013-03-31 13:55  0%   ` Luke A. Guest
  2013-03-31 11:41  0% ` Stephen Leake
  1 sibling, 1 reply; 200+ results
From: Brian Drummond @ 2013-03-30 22:10 UTC (permalink / raw)


On Sat, 30 Mar 2013 13:01:51 -0700, Diogenes wrote:

> First of all...thanks to everyone who have given me pointers on my
> initial runtime hacking experiments. I'm really trucking now.
> 
> Currently, just to gain some experience in this area, I building my own
> runtime targeted to the Native platform, but using a much more rigorous
> process. Using the Spark tools, unit testing everything, etc...
> 
> Since I'm working on the Ada Exceptions mechanism, I began to wonder if
> it might not make sense to add security related exceptions as a possible
> extension. I have ACLs going on one machine here, and of course Caps
> going on others.

I can't comment on extended exceptions.

However, when supporting exceptions in his RTS, Luke apparently ran into 
difficulties. If you have had more success - either using a different 
approach, or following his but overcoming his difficulties, then that 
would be useful. Is this going to be documented and/or made available 
somewhere?

- Brian




^ permalink raw reply	[relevance 0%]

* Extended Exceptions and other tweaks.
@ 2013-03-30 20:01  5% Diogenes
  2013-03-30 22:10  0% ` Brian Drummond
  2013-03-31 11:41  0% ` Stephen Leake
  0 siblings, 2 replies; 200+ results
From: Diogenes @ 2013-03-30 20:01 UTC (permalink / raw)


First of all...thanks to everyone who have given me pointers on my initial runtime hacking experiments. I'm really trucking now.

Currently, just to gain some experience in this area, I building my own runtime targeted to the Native platform, but using a much more rigorous process. Using the Spark tools, unit testing everything, etc...

Since I'm working on the Ada Exceptions mechanism, I began to wonder if it might not make sense to add security related exceptions as a possible extension. I have ACLs going on one machine here, and of course Caps going on others.

Would something like this be useful to the community, or would it be too much? Since a security related exception does not necessarily indicate an error in the program itself; it could indicate a conflict with the policy set up by a System Administrator. Seems like it might be prudent to indicate that explicitly.

Are there any other tweaks or extensions that people might find useful?

Diogenes



^ permalink raw reply	[relevance 5%]

* Re: Runtime startup code for the GNAT Runtime...and a bit of humble pie.
  2013-03-27  0:28  5%     ` Diogenes
@ 2013-03-27 10:05  0%       ` Brian Drummond
  0 siblings, 0 replies; 200+ results
From: Brian Drummond @ 2013-03-27 10:05 UTC (permalink / raw)


On Tue, 26 Mar 2013 17:28:51 -0700, Diogenes wrote:

> On Tuesday, March 26, 2013 5:57:21 PM UTC-4, Shark8 wrote:

> The GNAT Runtime is SUPPOSED to be Neutral. It tries to separate the
> runtime into GNARL(The Independent part of the runtime) and GNULL(The
> platform specific part of the runtime.)
> The problem is navigating the code. You have to check both the spec and
> the body. And there you have a real spaghetti factory going on. For
> example...
> 
> Ada.Exceptions withs System.Standard_Library System.Standard_Library
> withs System.Memory System.Memory(body) withs Ada.Exceptions
> 
> Ummm...yeah...how to unravel that one?

This is not actually circular : more of a helix since the loop is closed 
by a (body) dependent on the start point. So, while I take your point, 
it's not actually unclean like #include, but definitely harder to read 
and understand.

> So I figure I might just be better off writing my own implementations of
> these things that have NO circular dependencies. One specific goal of my
> runtime is a clear hierarchy that progress directly from ada.ads out to
> the leaf packages(nodes). No circular deps. No package should depend on
> another package that depends on the first package.
> 
> This structure should take about %60 of the teeth gnashing out of the
> porting process.

Excellent. I wonder if it is possible to work towards a completely non-
Gnarl runtime with a compatible API so that there are no changes required 
to the compiler? 

One (possible) advantage of that would be that we could start with a 
clean sheet on the license conditions if we wanted : the FSF Gnat tree 
seems to have inherited the GMGPL exception while Adacore's Libre tree 
and a lot of derivatives including ORK are pure GPL. 

To me, an unambiguously GMGPL RTS would seem an advantage (though I can 
understand if you regard pure GPL as the only way to go)

For my part I am considering undertaking only as much as is required to 
support Ravenscar and making that as small as possible, but a lot of 
shared understanding will help both projects.

- Brian


^ permalink raw reply	[relevance 0%]

* Re: Runtime startup code for the GNAT Runtime...and a bit of humble pie.
  @ 2013-03-27  0:28  5%     ` Diogenes
  2013-03-27 10:05  0%       ` Brian Drummond
  0 siblings, 1 reply; 200+ results
From: Diogenes @ 2013-03-27  0:28 UTC (permalink / raw)


On Tuesday, March 26, 2013 5:57:21 PM UTC-4, Shark8 wrote:
> 
> That's a very good question.
> 
> Sadly I have no answer for you -- I know Tasking and certain attributes, like 'Image, need it.

Naturally. Just need to build things up one step at a time. And build them well.

> 
> 
> That may be a bad call, if I'm reading you right.
> 
> 
> 
> Wouldn't it be best to write it first in a way so your [hardware] 
> dependencies are in one spot and secondly [and possibly separately] the 
> platform-dependence? {IOW, get it to a state where a no-OS body could be   
> supplied as well as an optimized-for-the-OS. Tying your runtime to pthreads 
> [POSIX] early on might be a rather bad idea... as you don't want to force 
> POSIX on the people who would want bare-metal access [or conceivably their 
> own OS].}

Actually that's exactly what I'm planning. First writing an arch/platform neutral layer that ISN'T tied to Posix. Underneath that I'll be using calls to clone(), futex(), etc.. for the Linux platform, BUT these should be easily replaceable for whatever arch/platform combo the developer is using.

> 
> > I'm suspecting I'll be limited to procedures and functions exclusively, but hey, at this level that's all I'll need to get started.
> 
> 
> 
> That's certainly a good thing.

The GNAT Runtime is SUPPOSED to be Neutral. It tries to separate the runtime into GNARL(The Independent part of the runtime) and GNULL(The platform specific part of the runtime.)
The problem is navigating the code. You have to check both the spec and the body. And there you have a real spaghetti factory going on. For example...

Ada.Exceptions withs System.Standard_Library
System.Standard_Library withs System.Memory
System.Memory(body) withs Ada.Exceptions

Ummm...yeah...how to unravel that one?

So I figure I might just be better off writing my own implementations of these things that have NO circular dependencies. One specific goal of my runtime is a clear hierarchy that progress directly from ada.ads out to the leaf packages(nodes). No circular deps. No package should depend on another package that depends on the first package.

This structure should take about %60 of the teeth gnashing out of the porting process.

^ permalink raw reply	[relevance 5%]

* Re: Bootstrapping a null procedure. Seriously?!
  @ 2013-03-13  4:34  5% ` anon
  0 siblings, 0 replies; 200+ results
From: anon @ 2013-03-13  4:34 UTC (permalink / raw)



To compile a barebone Ada program you must not use "gnatmake" 
or "gnat make" because it auto execute the Ada binder "gnatbind" 
and the "gnat linker". Gnat's binder and linker can not be used 
because they creates an os bound program. And they also adds a 
number of simple routines that may not be required for your 
program.

Any and all subunits and libraries that requires elaboration must 
be done manually first, within the main program. Normally this job 
is handled by the Gnat binder. The elaboration code can be in cased 
within a procedure or function that is called by the main program.

Also, you can not use the standard "raise" statement or the 
standard exception handlers. For exceptions to work, Gnat
compiler requires a number of System packages be load as well 
as "Ada.Exceptions". 


# --
# --  Makefile
# --
gnat compile testnulmain.adb
#
#  use -nostdinclib to remove most of gcc standard libraries
#      but os startup code is included from "libc".
#  additional libraries files, if included must be added to 
#  the command line.
#  
#  To reduce code to the basic user created only code use the
#   -T <file> command. The file defines ".text", ".data", 
#  ".rodata", and ".bss" setions and then discard all other 
#  sections.
#
#  Note: use -o testnulmain.exe for all microsoft based os(s)
#        gcc only support ".com" files with the -T <file> option
#
gcc -nostdinclib -o testnulmain testnulmain.o


--
--  testnulmain.ads
--
procedure testnulmain ;
  --
  --  Required by linker
  --
  pragma Export ( Ada, testnulmain, "main" ) ;


--
--  testnulmain.adb
--
--    Can include "Stand-Alone" Ada packages, like Ada.Characters,
--    Ada.Interfaces, or System. Actually any Ada library that 
--    does not require direct or indirect OS linking can be used.
--
with System ;
procedure TestNulMain is

  --
  --  In this example System.o is not needed to link file
  --
  TestVar : System.Address := System.Null_Address ;

begin

  --  preform elaboration here first

  null ;
end TestNulMain ;


In <19d330ec-9b61-414e-abc3-e25a8c786b81@googlegroups.com>, Diogenes <phathax0r@gmail.com> writes:
>I've been doing some binder experiments with this little gem....
>
>procedure nullmain is
>
>begin
>
>  null;
>
>end nullmain;
>
>
>Been doing it to see just how many packages from the runtime have to be lin=
>ked in order for the the thing to DO NOTHING!
>
>40 packages are pulled in.
>
>By most measures of good software design, this is WRONG.
>
>So here's the question...
>
>Do I need to have different a-finali.ads/.adb packages and the correspondin=
>g crt1.o implementations for every possible variation on the runtime I coul=
>d ever want? I mean, seriously, it's pulling in system.string_opts; does an=
>yone see strings in the above code?
>
>Of course I realize this is partly due to package dependency issues, howeve=
>r I SHOULD be able to write my own a-finali.ads that does nothing but make =
>a _start symbol for the system linker, right?
>
>Tips?
>




^ permalink raw reply	[relevance 5%]

* Is this expected behavior or not
@ 2013-03-11 19:42  6% Anh Vo
  0 siblings, 0 replies; 200+ results
From: Anh Vo @ 2013-03-11 19:42 UTC (permalink / raw)


I have read ARM section 3.2.4, Subtype Predicates, I did not see any rules prohibiting from using attribute 'Succ as contained in the code nipet below. I would expect Prime'Succ (3) return 5 for next prime number. However, 4 is returned instead. Is this a correct behavior?

pragma Assertion_Policy (Check);
with Ada.Text_Io;
with Ada.Exceptions; use Ada;

procedure Predicates_Test is
   use Text_Io;

   subtype Prime is Natural range 1 .. 1000
      with Dynamic_Predicate =>
      (case Prime is
         when 1 => False,
         when 2 => True,
         when others => Prime mod 2 /= 0 and then
                        (for all K in 3 .. Prime - 1 => Prime mod K /= 0));

   Current_Prime_Number : constant Natural := 3;
   Next_Prime_Number : constant Natural := 5;

begin
   Put_Line ("Predicates_Test starts");

   if Prime'Succ (Current_Prime_Number) = Next_Prime_Number then
      Put_Line ("The next prime number matches expectation");
   else
      Put_Line (Prime'Succ(Current_Prime_Number)'Img &
                                              " is not an expected number");
   end if;

   Put_Line ("Predicates_Test ends");
exception
   when Err : others =>
      Put_Line ("Houston we have a problem: " &
                                       Exceptions.Exception_Information(Err));
end Predicates_Test;




^ permalink raw reply	[relevance 6%]

* Re: Ada and OpenMP
  2013-03-09  4:13  6%               ` Brad Moore
@ 2013-03-10  4:24  0%                 ` Randy Brukardt
  0 siblings, 0 replies; 200+ results
From: Randy Brukardt @ 2013-03-10  4:24 UTC (permalink / raw)


"Brad Moore" <brad.moore@shaw.ca> wrote in message 
news:513AB6D3.6030106@shaw.ca...
> On 08/03/2013 4:36 PM, Randy Brukardt wrote:
...
>> Take the OP's example, for example:
>>
>> for I in 1 .. MAX loop
>>     A(I) := A(I) + 1; -- Can raise Constraint_Error because of overflow 
>> or
>> range checks.
>> end loop;
>>
>> This can be done in parallel only if (A) there is no exception handler 
>> for
>> Constraint_Error or others anywhere in the program; or
>
> I am working towards a new version of Paraffin to be released soon that 
> handles exceptions in such loops (as well as a number of other features).
>
> The technique though, is to have the workers catch any exception that 
> might have been raised in the users code, and then call 
> Ada.Exceptions.Save_Occurence to save the exception to be raised later.

I'd expect this to work fine - it's how I'd implement it if I was doing 
that. The issue, though, is that this changes the semantics of the loop WRT 
to exceptions. Specifically, the parts of A that get modified would be 
unspecified, while that's not true for the sequential loop (the items that 
are modified have to be a contiguous group at the lower end of the array).

That's fine for Paraffin, because no one will accidentally use it expecting 
deterministic behavior. It's not so clear when you actually write the loop 
syntax. Which is why a parallel loop syntax seems valuable, as it would make 
it explicit that parallelism is expected (and would also allow checking for 
dependencies between iterations, which usually can't be allowed).

Of course, an alternative would be just to standardize a library like 
Paraffin for this purpose, possibly with some tie-in to the iterator syntax. 
(I know you proposed something on this line, but too late to include in Ada 
2012.)

                                        Randy.





^ permalink raw reply	[relevance 0%]

* Re: Ada and OpenMP
  @ 2013-03-09  4:13  6%               ` Brad Moore
  2013-03-10  4:24  0%                 ` Randy Brukardt
  0 siblings, 1 reply; 200+ results
From: Brad Moore @ 2013-03-09  4:13 UTC (permalink / raw)


On 08/03/2013 4:36 PM, Randy Brukardt wrote:
> "Shark8" <onewingedshark@gmail.com> wrote in message
> news:9e0bbbdf-ccfa-4d4c-90af-2d56d46242b3@googlegroups.com...
>> On Thursday, March 7, 2013 8:42:15 PM UTC-7, Randy Brukardt wrote:
>>>
>>> In order for that to be the case, the pragma would have to make various
>>> constructs illegal in the loop and in the surrounding code (exception
>>> handlers, any code where one iteration of the loop depends on the next,
>>> erroneous use of shared variables). But a pragma shouldn't be changing
>>> the
>>> legality rules of the language. (And it's not clear this would really fix
>>> the problem.)
>>
>> Why would that have to change the semantics of the program: since there
>> would have
>> to be a non-implementation-defined code-generation method (for when the
>> pragma
>> was off) the compiler should just use that if those constructs are used.
>
> Mainly because 95% of Ada code is going to fail such tests; it would
> virtually never be able to use the fancy code.
>
> Take the OP's example, for example:
>
> for I in 1 .. MAX loop
>     A(I) := A(I) + 1; -- Can raise Constraint_Error because of overflow or
> range checks.
> end loop;
>
> This can be done in parallel only if (A) there is no exception handler for
> Constraint_Error or others anywhere in the program; or

I am working towards a new version of Paraffin to be released soon that 
handles exceptions in such loops (as well as a number of other features).

The technique though, is to have the workers catch any exception that 
might have been raised in the users code, and then call 
Ada.Exceptions.Save_Occurence to save the exception to be raised later.

Once all workers have completed their work before returning to let the 
sequential code continue on, a check is made to see if any occurrences 
were saved. If so, then Ada.Exceptions.Reraise_Occurrence is called, to
get the exception to appear in the same task that invoked the parallelism.

Testing so far indicates this seems to work well, maintaining the 
exception abstraction as though the code were being executed 
sequentially. Currently only the most recent exception is saved, so if
more than one exception is raised by the parallel workers, only one will
get fed back to the calling task, but I think thats OK, as that would 
have been the behaviour for the sequential case. Such an exception also 
sets a flag indicating the work is complete, which attempts to get other 
workers to abort their work as soon as possible. Also, under GNAT at 
least, this exception handling logic doesn't appear to impact 
performance. Apparently they use zero cost exception handling which 
might be why. I'm not sure what sort of impact that might have on other 
implementations that model exceptions differently. Hopefully, it 
wouldn't be a significant impact.

Brad

(B) pragma Suppress
> applies to the loop (nasty, we never, ever want an incentive to use
> Suppress); or (C) no exception handler or code following the handler can
> ever access A (generally only possible if A is a local variable, not a
> parameter or global). For some loops there would be a (D) be able to prove
> from subtypes and constraints that no exception can happen -- but that is
> never possible for increment or decrement operations like the above. These
> conditions aren't going to happen that often, and unless a compiler has
> access to the source code for the entire program, (A) isn't possible to
> determine anyway.
>
> And if the compiler is going to go through all of that anyway, it might as
> well just do it whenever it can, no pragma is necessary or useful.
>
> The whole advantage of having a "marker" here is to allow a change in the
> semantics in the error case. If you're not going to do that, you're hardly
> ever going to be able to parallelize, so what's the point of a pragma?
>
>                                         Randy.
>
>
>
>




^ permalink raw reply	[relevance 6%]

* Re: Class wide preconditions: error in GNAT implementation?
  @ 2013-02-16 20:23  5%   ` Simon Wright
  0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2013-02-16 20:23 UTC (permalink / raw)


"Randy Brukardt" <randy@rrsoftware.com> writes:

> OTOH, I didn't realize that you had a dispatching call. In that case,
> the precondition is supposed to just be the Pre'Class for A, which is
> stronger that A or B which a direct call would use. Probably GNAT
> dispatched and then checked the precondition. Technically, that's
> wrong (although I would have a hard time caring, the reason for the
> stronger precondition on dispatching calls is to allow analysis
> without knowing the actual tag, it doesn't have anything to do with
> correctness).

I think that the rule that GNAT appears to be breaking is 6.6.1(38)[1]?

I've constructed an example where GNAT's behaviour results in caller
code that used to work (with checks enabled) no longer working,
depending on the actual type for a classwide (an access-to-classwide,
as might be used if say the application logger could be changed at run
time):

with Ada.Exceptions; use Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;

procedure Conditions is

   package A_Pack is
      type T is tagged null record;
      not overriding
      procedure P (This : T; Var : Integer) is null
        with Pre'Class => Var >= 1;
   end A_Pack;

   package B_Pack is
      type T is new A_Pack.T with null record;
      overriding
      procedure P (This : T; Var : Integer) is null
        with Pre'Class => Var >= 0;                -- widening
   end B_Pack;

   package C_Pack is
      type T is new A_Pack.T with null record;
      overriding
      procedure P (This : T; Var : Integer) is null;
   end C_Pack;

begin

   declare
      O : access A_Pack.T'Class;
   begin
      O := new B_Pack.T;
      Put_Line ("passing 0 to an actual B_Pack.T");
      O.P (0);
      Put_Line ("success.");
      O := new C_Pack.T;
      Put_Line ("passing 0 to an actual C_Pack.T");
      O.P (0);
      Put_Line ("success.");
   exception
      when E : others =>
         Put_Line (Exception_Information (E));
   end;

end Conditions;

and the output is

$ ./conditions 
passing 0 to an actual B_Pack.T
success.
passing 0 to an actual C_Pack.T
Exception name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: failed inherited precondition from conditions.adb:10


[1] http://www.ada-auth.org/standards/12aarm/html/AA-6-1-1.html#p38



^ permalink raw reply	[relevance 5%]

* Assertion_Policy implementation regarding Aspect Features
@ 2013-02-09  1:52  7% Anh Vo
  0 siblings, 0 replies; 200+ results
From: Anh Vo @ 2013-02-09  1:52 UTC (permalink / raw)


I revisited "about the new Ada 2012 pre/post conditions" thread posted by Nasser M. Abbasi, https://groups.google.com/forum/?fromgroups#!search/aspect$20example$20in$20Ada$202012/comp.lang.ada/t4w2M1NVFwI/qOXDIyT6JJ0J.

This inspires me to learn this feature a little bit deeper. I would like to know if GNAT comply with ARM by showing the following scenarios.


------------ Scenario 1 --------------
with Ada.Text_Io;
with Ada.Exceptions; use Ada;

procedure Predicates_Test is
   use Text_Io;

   type Even is new Integer range 0 .. Integer'Last
      with Dynamic_Predicate => Even mod 2 = 0,
           Default_Value => 0;

   My_Number : Even; -- set to 0 by default

begin
   Put_Line ("Predicates_Test starts");
   Put_Line ("Initial My_Number => " & My_Number'Img);
   My_Number := 3;  -- intentionally violate predicate rules
   Put_Line ("Final My_Number => " & My_Number'Img);
   Put_Line ("Predicates_Test ends");
exception
   when Err : others =>
      Put_Line ("Houston we have a problem: " & 
                                       Exceptions.Exception_Information(Err));
end Predicates_Test;

 For scenario 1 the code is compiled with gnatmake -gnat12 -gnata. When running this program, the output is as follows: 

Predicates_Test starts
My_Number =>  0
Houston we have a problem: Exception name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: predicate failed at predicates_test.adb:16

Observation: GNAT implemented the Aspect feature even pragma Assertion_Policy (Check) is not present.


------------ Scenario 2 --------------
pragma Assertion_Policy (Check);
with Ada.Text_Io;
with Ada.Exceptions; use Ada;

procedure Predicates_Test is
   use Text_Io;

   type Even is new Integer range 0 .. Integer'Last
      with Dynamic_Predicate => Even mod 2 = 0,
           Default_Value => 0;

   My_Number : Even; -- set to 0 by default

begin
   Put_Line ("Predicates_Test starts");
   Put_Line ("Initial My_Number => " & My_Number'Img);
   My_Number := 3;  -- intentionally violate predicate rules
   Put_Line ("Final My_Number => " & My_Number'Img);
   Put_Line ("Predicates_Test ends");
exception
   when Err : others =>
      Put_Line ("Houston we have a problem: " & 
                                       Exceptions.Exception_Information(Err));
end Predicates_Test;


For scenario 2, it is compliled with gnatmake -gnat12. Then running this program yielding output as

Predicates_Test starts
Initial My_Number =>  0
Final My_Number =>  3
Predicates_Test ends

Observation: GNAT did not implement the Aspect feature even though pragma Assertion_Policy (Check) is present.


------------ Scenario 3 --------------
pragma Assertion_Policy (Check);
with Ada.Text_Io;
with Ada.Exceptions; use Ada;

procedure Predicates_Test is
   use Text_Io;

   type Even is new Integer range 0 .. Integer'Last
      with Dynamic_Predicate => Even mod 2 = 0,
           Default_Value => 0;

   My_Number : Even; -- set to 0 by default

begin
   Put_Line ("Predicates_Test starts");
   Put_Line ("Initial My_Number => " & My_Number'Img);
   My_Number := 3;  -- intentionally violate predicate rules
   Put_Line ("Final My_Number => " & My_Number'Img);
   Put_Line ("Predicates_Test ends");
exception
   when Err : others =>
      Put_Line ("Houston we have a problem: " & 
                                       Exceptions.Exception_Information(Err));
end Predicates_Test;


For scenario 3, it is compliled with gnatmake -gnat12 -gnata. Then running this program yielding output as below.

Predicates_Test starts
Initial My_Number =>  0
Houston we have a problem: Exception name: SYSTEM.ASSERTIONS.ASSERT_FAILURE
Message: predicate failed at predicates_test.adb:17


Observation: GNAT implements Aspect feature through compiler option.


Thanks in advance for your insight.


Anh Vo



^ permalink raw reply	[relevance 7%]

* Re: Sockets Example Sought
  @ 2012-11-28  4:43  4% ` anon
  0 siblings, 0 replies; 200+ results
From: anon @ 2012-11-28  4:43 UTC (permalink / raw)


-- 
--  TCP/IP Echo Service Daemon, based on RFC 342 and RFC 862
--  Normally, a Sender program that accepts a word or quoted
--  sentence from command line is transmitted to the server and
--  the return message is displayed.
-- 
--  This Daemon was tested using "Ada Dual TCP/IP Stacks" using
--  IPv6 and Linux IPv4,
-- 
-- 
--  Protocol: TCP
--  Protocol: UDP not setup at this time.
-- 
--  Usage:    Listener
-- 
--  Tester:   Telnet <hostname>  -port 7
--  Example:  Telnet 127.0.0.1 7
-- 
--  While telnet operational every character including control
--  characters will be echoed
-- 

with Ada.Characters.Latin_9 ;
with Ada.Exceptions ;
with Ada.Text_IO ;
with GNAT.Sockets ;   -- GNAT to reg OS
-- with Sockets ;     -- Ada TCP/IP Stacks

use Ada.Characters.Latin_9 ;
use Ada.Exceptions ;
use Ada.Text_IO ;
use GNAT.Sockets ;
-- use Sockets ;     -- Ada TCP/IP Stacks

procedure Listener is

  --
  --  Operational options
  --
  --  Set to True to use IPv6, But some GNAT.Socket packages, are
  --  not setup to handle IPv6 yet. One way to check is to look at
  --  the body for the "Bind" function. Because the "Bind" function
  --  raises a exception, if IPv6 is use, for those packages that
  --  are IPv4 only.
  --
  IP_V6   : constant Boolean := False ;
  --
  -- Displays a logging message if True
  --
  LOGGING : constant Boolean := False ;

  task type Echo is
    entry Start ( Incoming : Socket_Type ) ;
  end Echo ;

  type Echo_Access is access Echo ;
  type Sock_Addr_Access is access all Sock_Addr_Type ;

  --
  -- Echo -- the main processthat preforms the echo operation
  --      -- one problem is there is no recovery of memory use
  --         by this task once the task ends.
  --

  task body Echo is
      Data     : Character     ;

      Channel  : Stream_Access ;
      Socket   : Socket_Type   ;

    begin
      accept Start ( Incoming : Socket_Type ) do
          Socket := Incoming ;
      end Start ;

      Channel := Stream ( Socket ) ;
      loop
        Data := Character ' Input ( Channel ) ;
        exit when Data = ASCII.Nul ;
        Character ' Output ( Channel, Data ) ;
      end loop ;
      Close_Socket ( Socket ) ;
    exception
      when Socket_Error =>
          Put_Line ( "Connection closed" ) ;
          Close_Socket ( Socket ) ;
    end Echo ;

  --
  Accepting_Socket : Socket_Type ;
  Incoming_Socket  : Socket_Type ;
  Address          : Sock_Addr_Access ;

  Dummy            : Echo_Access ;

  TCP_Error        : exception ;

begin
  --  
  --  Create Socket and sets stacks. With error checking to insure
  --  stacks is valid because some system only have IPv4 and other
  --  have remove IPv4. If both stacks are installed and GNAT
  --  allows both, then use IPv6.
  --
  if IP_V6 then
    begin
      --
      -- set IPv6
      --
      Create_Socket ( Accepting_Socket, Family_Inet6, Socket_Stream ) ;
      Address := new Sock_Addr_Type ( Family_Inet6 );
    exception
      when Socket_Error =>
        Put_Line ( "Error: IP version 6 is not supported" ) ;
        raise TCP_Error ;
    end ;
  else
    begin
      --
      -- set Default IPv4
      --
      Create_Socket ( Accepting_Socket ) ;
      Address := new Sock_Addr_Type ;
    exception
      when Socket_Error =>
        Put_Line ( "Error: IP version 4 is not supported" ) ;
        raise TCP_Error ;
    end ;
  end if ;
  --
  --  Address.Addr is current host can be localhost
  --  Address.Port is 7 based on RFC 342 update RFC 862
  --
  Address.all.Addr := Addresses ( Get_Host_By_Name ( Host_Name ), 1 ) ;
  Address.all.Port := 7 ;
  --
  --  Bind Address to socket
  --
  Bind_Socket ( Accepting_Socket, Address.all ) ;
  --
  --  Set stacks to receive connect events
  --
  Listen_Socket ( Accepting_Socket ) ;
  --
  --  Handle connections
  --
  loop
    --
    --  Wait until client request connect then accept connection
    --
    Accept_Socket ( Accepting_Socket,
                    Incoming_Socket, Address.all ) ;
    --
    --  Log message, if required
    --
    if LOGGING then
      Put ( "Received From: " ) ;
      Put ( Image ( Address.all ) ) ;
    end if ;
    --
    --  Create a single usage task to handle daemon process
    --  task will die once connection is ended.  In this design
    --  there is a possible memory leak because once the task
    --  dies there is no memory recover of the dead task.
    --
    Dummy := new Echo ;
    Dummy.Start ( Incoming_Socket ) ;
  end loop ;

exception
  when TCP_Error =>
      Put_Line ( "Error: Server was not initialized" ) ;

  when others =>
      Put_Line ( "Error: Server is beening shutdown" ) ;
      Shutdown_Socket ( Accepting_Socket, Shut_Read_Write ) ;
end Listener ; 

In <2012112311175432190-rblove@airmailnet>, Robert Love <rblove@airmail.net> writes:
>Does anyone have an example of a multi-client server in Ada they care 
>to share?  It should use the Gnat.Sockets package.  I've seen samples 
>but they don't seem complete, or at least my understanding isn't 
>complete<grin>.
>
>Thanks in advance.
>
>




^ permalink raw reply	[relevance 4%]

* Re: Tasking troubles, unexpected termination.
  @ 2012-10-31  2:17  5%     ` Shark8
  0 siblings, 0 replies; 200+ results
From: Shark8 @ 2012-10-31  2:17 UTC (permalink / raw)


Here's the updated code:

---- Scheduling.adb ------------------------------------------
with
Ada.Text_IO,
Ada.Calendar,
Ada.Containers.Indefinite_Vectors,
Ada.Task_Termination,
Ada.Task_Identification,
Task_Debugging;

Procedure Scheduling is

    -- Introduce shorthand so convert Strings to access strings.
    Function "+" (Item : String) Return Not Null Access String is
      ( New String'(Item) );
    
    -- Forward declare the Notification type; indicate it has discriminants.
    Type Notification(<>);
    
    -- Declare Handle for Notifications.
    Type Notification_Handle is Not Null Access Notification;
    
    Type Notification(	Message	: Not Null Access String;
			Expiry	: Not Null Access Ada.Calendar.Time
		     ) is null record;
    
    -- Declare the Timing-task.
    Task Type Timing ( Resolution : Not Null Access Duration ) is
	Entry Add( Event : Notification_Handle );
    end Timing;

    
    -- Implementation for the timing-task.
    Task body Timing is

	-- Package for showing Duration.
	Package Decimal_Display is new Ada.Text_IO.Fixed_IO( Duration );
	
	-- Internal package, defining Vectors holding notification handles.
	Package Notification_Vector is New Ada.Containers.Indefinite_Vectors
	  ( Index_Type => Positive, Element_Type => Notification_Handle );
	Use Notification_Vector;
	
	-- Handle expired messages.
	Procedure Handle_Expiration( List : in out Vector ) is
	    Use Ada.Calendar, Ada.Text_IO;
	    Length : Positive:= Positive(List.Length);
	    Now    : Time:= Clock;

	    -- We flag everything to be deleted, as tampering with the cursor is
	    -- not good.
	    Type Deletion_Flags is Array(1..Length) of Boolean;
	    Deletion_Marks : Deletion_Flags:= (Others => False);
	    
	    
	    procedure Execute(Position : Cursor) is
		Item	: Constant Notification_Handle:= Element(position);
		Index	: Constant Positive:= Positive( To_Index(position) );
	    begin
		Deletion_Marks(Index):= Now >= Item.Expiry.All;
		--
		Ada.Text_IO.Put( ASCII.HT & "Exipration: " );
		Decimal_Display.Put( Item.Expiry.All - Now, Fore => 2, Aft => 3 );
		Ada.Text_IO.New_Line;
	    end Execute;

	begin
	    -- Iterate through the vector's elements; old-style iterator.
	    List.Reverse_Iterate( Process => Execute'Access );

	    -- Delete flagged elements; iteration bckwards to preserve indicies.
	    For Index in reverse Deletion_Marks'Range loop
		if Deletion_Marks(Index) then
		    
		    Put_Line( "Message: " & List(Index).Message.All);
		    List.Delete( Index );
		end if;
	    end loop;
	    
	    -- Render a report on the new length, if it was altered.
	    declare
		Post_op_length : Natural:= Natural(List.Length);
	    begin
		if Length /= post_op_length then
		    Put_Line( "Deleted items; New Length:" &  post_op_length'Img);
		end if;
	    end;
	end Handle_Expiration;

	-- Declare a Vector to hold all the nofifications.
	Notification_List : Vector:= Empty_Vector;
	
	Use Ada.Task_Termination, Task_Debugging, Ada.Containers, Ada.Calendar;
	
	-- Mark the start-time.
	Start : Time:= Clock;
	
--	Function Elapsed Return String is
--	  ( Duration'Image(Clock - Start)(1..7) );
	Function Elapsed Return Duration is
	  ( Clock - Start );

    begin
	-- Set our debugging-handler for this task.
	Ada.Task_Termination.Set_Specific_Handler(
		T       => Ada.Task_Identification.Current_Task,
		Handler => Debug.Termination'Access );

	-- When there are no items in our internal vector, then we need can only
	-- accept Add or terminate the task.
	-- When we add an item, then we can either add another item or when the
	-- time expires iterate the vector and handling Notifications as needed.
	loop
	    select 
		accept Add( Event : Notification_Handle ) do
		    Notification_List.Append( Event );
		end add;
		while not Notification_List.Is_Empty loop
		    Ada.Text_IO.Put( "Elapsed:" );
		    Decimal_Display.Put( Elapsed, Fore => 2, Aft => 3 );
		    Ada.Text_IO.New_Line;
		    Handle_Expiration( List => Notification_List );
		    select
			accept Add( Event : Notification_Handle ) do
			    Notification_List.Append( Event );
			    Ada.Text_IO.Put_Line( "New Length: " & Notification_List.Length'Img );
			    Ada.Text_IO.Put( ASCII.HT & "Exipration: " );
			    Decimal_Display.Put( Event.Expiry.All - Clock, Fore => 2, Aft => 3 );
			    Ada.Text_IO.New_Line;
			end add;
		    or
			delay Timing.Resolution.All;
		    end select;
		end loop;
		Ada.Text_IO.Put_Line( "EMPTY." );
	    or
		terminate;
	    end select;
	end loop;
    end Timing;
    
    
      
    K : Timing( Resolution => New Duration'(2.0) ); -- 2 second resolution.
    Now : Ada.Calendar.Time:= Ada.Calendar.Clock;
begin
    For Index in 1..10 loop
	declare
	    Use Ada.Calendar;
	    Item : Notification(
			 Message => + ("DD"&Positive'Image(Index)),
			 -- Expire at Now and 3*Index seconds.
			 Expiry  => New Time'( Now + Duration(Index) )
			);
	begin
	    K.Add( Event => New Notification'(Item) );
	end;
    end loop;
    
    -- Add an element in the past... it should immediately be operated on.
    K.Add( Event => New Notification'(
	Message => + ("Last."),
	Expiry  => New Ada.Calendar.Time'( Now )
	)
    );

end Scheduling;

---- Task_Debugging.ads ----------------------------------------------
-- The following are not strictly nessacary, but used in this example for 
-- debugging purposes.
With
System.Address_To_Access_Conversions,
Ada.Unchecked_Conversion,
Ada.Exceptions.Traceback,
Ada.Task_Identification,
Ada.Task_Termination;

Package Task_Debugging is
    Pragma Elaborate_Body;
    
    Protected Type Debugging is
	-- Termination debugging function.
	procedure Termination(
				 Cause : Ada.Task_Termination.Cause_Of_Termination;
				 T     : Ada.Task_Identification.Task_Id;
				 X     : Ada.Exceptions.Exception_Occurrence);

    End Debugging;
    
    -- Debug, an instance of our debugging object.
    Debug : Debugging;
    
End Task_Debugging;

---- Task_Debugging.adb ----------------------------------------------
With Ada.Text_IO;

Package Body Task_Debugging is

    Protected body Debugging is
	-- Termination debugging function.
	procedure Termination(
		       Cause : Ada.Task_Termination.Cause_Of_Termination;
		       T     : Ada.Task_Identification.Task_Id;
		       X     : Ada.Exceptions.Exception_Occurrence) is
	    Use Ada.Text_IO, Ada.Task_Termination, Ada.Exceptions;
	begin
	    Put_Line("Termination: "& Cause'Img);
	    case Cause is
	    When Normal | Abnormal => Null;
	    When Unhandled_Exception =>
		Put_Line( Exception_Name(X)&": "&Exception_Message(X) );
	    end case;
	end Termination;	
    end Debugging;

End Task_Debugging;
---------------------------------------------------------------------------

I've fixed the original problems (first the "tampering", and second a constraint_error) but there's still something strange going on. The discriminants for notifications seem to be being ignored (or rather the latest one being used).

Here's the output:
C:\Programming\Projects\Scheduler>scheduling.exe
Elapsed: 0.000
        Exipration:  0.984
New Length:  2
        Exipration:  1.983
Elapsed: 0.002
        Exipration:  1.982
        Exipration:  1.982
New Length:  3
        Exipration:  2.981
Elapsed: 0.004
        Exipration:  2.980
        Exipration:  2.980
        Exipration:  2.980
[...]
Message: Last.
Deleted items; New Length: 10
Elapsed: 2.047
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
        Exipration:  7.938
Elapsed: 4.051
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
        Exipration:  5.933
Elapsed: 6.061
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
        Exipration:  3.923
Elapsed: 8.086
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
        Exipration:  1.898
Elapsed:10.106
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
        Exipration: -0.122
Message: DD 10
Message: DD 9
Message: DD 8
Message: DD 7
Message: DD 6
Message: DD 5
Message: DD 4
Message: DD 3
Message: DD 2
Message: DD 1
Deleted items; New Length: 0
EMPTY.
Termination: NORMAL

As you can see, instead of each element being different they're all tagged as having the same expiration.



^ permalink raw reply	[relevance 5%]

* Re: ZLIB_ERROR with AWS
  @ 2012-10-20 22:26  0%                   ` Okasu
  0 siblings, 0 replies; 200+ results
From: Okasu @ 2012-10-20 22:26 UTC (permalink / raw)


On 2012-10-20, Okasu <oka.sux@gmail.com> wrote:
> On 2012-10-20, Pascal Obry <pascal@obry.net> wrote:
>> Le 20/10/2012 23:15, Okasu a écrit :
>>> Oh, thanks a lot!
>>> Maybe there is some catch like this with zlib issue too?
>>
>> With Zlib you can tell if the one from the system is to be used or not.
>>
>>    $ make ZLIB=false setup
>>
>> Will force AWS to build it's own version of Zlib.
>>
> Great, thanks again.

I've make AWS with "make SOCKET=openssl ZLIB=false setup" and SSL works
fine now. But "raised ZLIB.ZLIB_ERROR : DATA_ERROR: incorrect header check"
still persists. Any suggestions?

>    procedure Finalize (...) is
>    begin
>       Ada.Text_IO.Put_Line
>       (  "#1 was:"
>       &  Ada.Exceptions.Exception_Information
>          (  GNAT.Most_Recent_Exception.Occurrence
>       )  );
>       ...
>
> at the end of the Finalize you add:
>
>       ...
>    exception
>       when Error : others =>
>          Ada.Text_IO.Put_Line
>          (  "#2 was:"
>          & Ada.Exceptions.Exception_Information (Error)
>          );
>          raise;
>    end Finalize;

With zlib case gives nothing but same error.



^ permalink raw reply	[relevance 0%]

* Re: ZLIB_ERROR with AWS
  2012-10-20  9:04  5%       ` Dmitry A. Kazakov
@ 2012-10-20 20:46  0%         ` Okasu
    2012-10-21  6:17  0%           ` darkestkhan
  0 siblings, 2 replies; 200+ results
From: Okasu @ 2012-10-20 20:46 UTC (permalink / raw)


On 2012-10-20, Dmitry A. Kazakov <mailbox@dmitry-kazakov.de> wrote:
> If you want that and have access to the sources, you could modify the code
> of the offending Finalize (where #2 propagates from) by adding at its
> beginning something like:
>
>    procedure Finalize (...) is
>    begin
>       Ada.Text_IO.Put_Line
>       (  "#1 was:"
>       &  Ada.Exceptions.Exception_Information
>          (  GNAT.Most_Recent_Exception.Occurrence
>       )  );
>       ...
>
> at the end of the Finalize you add:
>
>       ...
>    exception
>       when Error : others =>
>          Ada.Text_IO.Put_Line
>          (  "#2 was:"
>          & Ada.Exceptions.Exception_Information (Error)
>          );
>          raise;
>    end Finalize;
>
> Now in the output there should be lines "#1 was:" followed by "#2 was:",
> which could give a hint what is going on.

I made it (took ~1 hour to recompile AWS),  and here is output:
-----
#1 was:Exception name: PROGRAM_ERROR
Message: SSL not supported.

#2 was:Exception name: PROGRAM_ERROR
Message: SSL not supported.


raised PROGRAM_ERROR : aws-client.adb:290 finalize/adjust raised exception
-----

Why it tells me that SSL not supported?
I have openssl installed.




^ permalink raw reply	[relevance 0%]

* Re: ZLIB_ERROR with AWS
  @ 2012-10-20  9:04  5%       ` Dmitry A. Kazakov
  2012-10-20 20:46  0%         ` Okasu
  0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2012-10-20  9:04 UTC (permalink / raw)


On Sat, 20 Oct 2012 08:32:02 +0000 (UTC), Okasu wrote:

> On 2012-10-20, Dmitry A. Kazakov <mailbox@dmitry-kazakov.de> wrote:
>> No, it looks like a typical problem of the clean up involving controlled
>> types. That is when an exception is propagated amidst of some process
>> involving controlled objects in possibly not a coherent state. So that when
>> the propagation starts kicking them out of existence a call Finalize may
>> fail. That turns the original exception into Program_Error. This stuff is
>> barely testable, because one cannot foresee and emulate all possible
>> exceptions at all possible places. I bet that almost any Ada program has
>> issues of this kind. So, it is a bug, but not the original problem.
> 
> What bug are you talking about? Issue with zlib or finalize/adjust with HTTPS
> issue? 

Yes, that should never happen.

> Can you suggest workaround (without involving another
> language)?

It is likely not the original problem, it is an induced one:

A) There was an exception #1 which started winding the stack up (the
original issue)

B) Upon that in a Finalize of a controlled object happened an exception #2
(which is a secondary bug). Quite frequently this happens very lately when
the compiler kills strayed controlled objects at the library level. In that
case there is would be no stack trace at all.

C) #2 was not handled in Finalize, so the compiler converted it to the
exception #3, Program_Error, obscuring the things completely.

As for workarounds that depends on whether #1 was legitimate and how you
could prevent it from happening. Your first step could be to track #1 down.

If you want that and have access to the sources, you could modify the code
of the offending Finalize (where #2 propagates from) by adding at its
beginning something like:

   procedure Finalize (...) is
   begin
      Ada.Text_IO.Put_Line
      (  "#1 was:"
      &  Ada.Exceptions.Exception_Information
         (  GNAT.Most_Recent_Exception.Occurrence
      )  );
      ...

at the end of the Finalize you add:

      ...
   exception
      when Error : others =>
         Ada.Text_IO.Put_Line
         (  "#2 was:"
         & Ada.Exceptions.Exception_Information (Error)
         );
         raise;
   end Finalize;

Now in the output there should be lines "#1 was:" followed by "#2 was:",
which could give a hint what is going on.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de



^ permalink raw reply	[relevance 5%]

* Re: ZLIB_ERROR with AWS
  2012-10-20 20:46  0%         ` Okasu
  @ 2012-10-21  6:17  0%           ` darkestkhan
  1 sibling, 0 replies; 200+ results
From: darkestkhan @ 2012-10-21  6:17 UTC (permalink / raw)


On Saturday, October 20, 2012 8:46:31 PM UTC, Okasu wrote:
> On 2012-10-20, Dmitry A. Kazakov <mailbox@dmitry-kazakov.de> wrote:
> 
> > If you want that and have access to the sources, you could modify the code
> 
> > of the offending Finalize (where #2 propagates from) by adding at its
> 
> > beginning something like:
> 
> >
> 
> >    procedure Finalize (...) is
> 
> >    begin
> 
> >       Ada.Text_IO.Put_Line
> 
> >       (  "#1 was:"
> 
> >       &  Ada.Exceptions.Exception_Information
> 
> >          (  GNAT.Most_Recent_Exception.Occurrence
> 
> >       )  );
> 
> >       ...
> 
> >
> 
> > at the end of the Finalize you add:
> 
> >
> 
> >       ...
> 
> >    exception
> 
> >       when Error : others =>
> 
> >          Ada.Text_IO.Put_Line
> 
> >          (  "#2 was:"
> 
> >          & Ada.Exceptions.Exception_Information (Error)
> 
> >          );
> 
> >          raise;
> 
> >    end Finalize;
> 
> >
> 
> > Now in the output there should be lines "#1 was:" followed by "#2 was:",
> 
> > which could give a hint what is going on.
> 
> 
> 
> I made it (took ~1 hour to recompile AWS),  and here is output:
> 
> -----
> 
> #1 was:Exception name: PROGRAM_ERROR
> 
> Message: SSL not supported.
> 
> 
> 
> #2 was:Exception name: PROGRAM_ERROR
> 
> Message: SSL not supported.
> 
> 
> 
> 
> 
> raised PROGRAM_ERROR : aws-client.adb:290 finalize/adjust raised exception
> 
> -----
> 
> 
> 
> Why it tells me that SSL not supported?
> 
> I have openssl installed.

IIRC, OpenSSL isn't supported by default because of licence incompatibility.

Also for exception propagated too deep - you can attach gdb to the process ("catch exception" - Ada specific command for gdb which will catch every exception, before they get propagated). Though I understand not wanting to use debugger.



^ permalink raw reply	[relevance 0%]

* Re: OS X 10.8 Mountain Lion and GNAT GPL 2012
  @ 2012-09-19  1:00  5%           ` Jerry
  0 siblings, 0 replies; 200+ results
From: Jerry @ 2012-09-19  1:00 UTC (permalink / raw)


On Tuesday, September 18, 2012 8:54:19 AM UTC-7, Bill Findlay wrote:
> On 18/09/2012 02:06, in article
> 
> 
> 
> 
> 
> >  
> 
> >> 
> 
> >>> Wow. That's going to be a problem--on top of the other gdb/Ada/OS X issues
> 
> >>> we've had / are having.
> 
> > 
> 
> >> What are those?
> 
> >> 
> 
> >> Bill Findlay
> 
> >> 
> 
> > You can start here:
> 
> > https://groups.google.com/forum/?hl=en&fromgroups=#!topic/comp.lang.ada/TBrs7T
> 
> > TSUvs
> 
> > 
> 
> > and
> 
> > 
> 
> > https://groups.google.com/forum/?hl=en&fromgroups=#!topic/comp.lang.ada/Eahf6e
> 
> > WqnpQ
> 
> > 
> 
> > You might find other troubles here:
> 
> > 
> 
> > https://groups.google.com/forum/?hl=en&fromgroups#!searchin/comp.lang.ada/gdb$
> 
> > 20AND$20(OSX$20OR$20%22OS$20X%22$20OR$20Macintosh$20OR$20Leopard$20OR$20Lion)
> 
> 
> 
> 
> 
> I did not see anthingy else there about 10.8 or GNAT 2012.
> 
> 
> 
> -- 
> 
> Bill Findlay
> 
> with blueyonder.co.uk;
> 
> use  surname & forename;

That's not surprising since both of these updates are relatively new. I personally have not updated either and am on GNAT 2011 and OS X 10.7.4. I wonder if, with 2012 and 10.8, for example, gdb honors breaking on Ada exceptions.

Jerry

[Sorry if my posts look hosed--I'm using Google's abysmal news reader. I welcome any suggestions that can deal with the fact that my ISP does not provide newsgroup feeds.]



^ permalink raw reply	[relevance 5%]

* Re: Help writing first daemon  Heres a Server
  @ 2012-09-09  7:26  4% ` anon
  0 siblings, 0 replies; 200+ results
From: anon @ 2012-09-09  7:26 UTC (permalink / raw)


--
--  TCP/IP Echo Service Daemon, based on RFC 342 and RFC 862
--  Normally, a Sender program that accepts a word or quoted 
--  sentence from command line is transmitted to the server and 
--  the return message is displayed. 
--
--  This Daemon was tested using "Ada Dual TCP/IP Stacks" using
--  IPv6 and Linux IPv4,
--
--
--  Protocol: TCP
--  Protocol: UDP not setup at this time.
--
--  Usage:    Listener
--
--  Tester:   Telnet <hostname>  -port 7
--  Example:  Telnet 127.0.0.1 7
--
--  While telnet operational every character including control 
--  characters will be echoed
--

with Ada.Characters.Latin_9 ;
with Ada.Exceptions ;
with Ada.Text_IO ;
with GNAT.Sockets ;   -- GNAT to reg OS 
-- with Sockets ;     -- Ada TCP/IP Stacks

use Ada.Characters.Latin_9 ;
use Ada.Exceptions ;
use Ada.Text_IO ;
use GNAT.Sockets ;
-- use Sockets ;     -- Ada TCP/IP Stacks

procedure Listener is

  --
  --  Operational options
  --
  --  Set to True to use IPv6, But some GNAT.Socket packages, are
  --  not setup to handle IPv6 yet. One way to check is to look at 
  --  the body for the "Bind" function. Because the "Bind" function
  --  raises a exception, if IPv6 is use, for those packages that 
  --  are IPv4 only.
  --
  IP_V6   : constant Boolean := False ;
  --
  -- Displays a logging message if True 
  --
  LOGGING : constant Boolean := False ;



  task type Echo is
    entry Start ( Incoming : Socket_Type ) ;
  end Echo ;

  type Echo_Access is access Echo ;
  type Sock_Addr_Access is access all Sock_Addr_Type ;

  --
  -- Echo -- the main processthat preforms the echo operation
  --      -- one problem is there is no recovery of memory use 
  --         by this task once the task ends.
  --

  task body Echo is
      Data     : Character     ;

      Channel  : Stream_Access ;
      Socket   : Socket_Type   ;

    begin
      accept Start ( Incoming : Socket_Type ) do
          Socket := Incoming ;
      end Start ;

      Channel := Stream ( Socket ) ;
      loop
        Data := Character ' Input ( Channel ) ;
        exit when Data = ASCII.Nul ;
        Character ' Output ( Channel, Data ) ;
      end loop ;
      Close_Socket ( Socket ) ;
    exception
      when Socket_Error =>
          Put_Line ( "Connection closed" ) ;
          Close_Socket ( Socket ) ;
    end Echo ;

  --
  Accepting_Socket : Socket_Type ;
  Incoming_Socket  : Socket_Type ;
  Address          : Sock_Addr_Access ;

  Dummy            : Echo_Access ;

  TCP_Error        : exception ;

begin
  --  
  --  Create Socket and sets stacks. With error checking to insure 
  --  stacks is valid because some system only have IPv4 and other 
  --  have remove IPv4. If both stacks are installed and GNAT 
  --  allows both, then use IPv6.
  --
  if IP_V6 then
    begin
      --
      -- set IPv6
      --
      Create_Socket ( Accepting_Socket, Family_Inet6, Socket_Stream ) ;
      Address := new Sock_Addr_Type ( Family_Inet6 );
    exception
      when Socket_Error =>
        Put_Line ( "Error: IP version 6 is not supported" ) ;
        raise TCP_Error ;
    end ;
  else
    begin
      --
      -- set Default IPv4
      --
      Create_Socket ( Accepting_Socket ) ;
      Address := new Sock_Addr_Type ;
    exception
      when Socket_Error =>
        Put_Line ( "Error: IP version 4 is not supported" ) ;
        raise TCP_Error ;
    end ;
  end if ;
  --
  --  Address.Addr is current host can be localhost
  --  Address.Port is 7 based on RFC 342 update RFC 862 
  --
  Address.all.Addr := Addresses ( Get_Host_By_Name ( Host_Name ), 1 ) ;
  Address.all.Port := 7 ;
  --
  --  Bind Address to socket
  --
  Bind_Socket ( Accepting_Socket, Address.all ) ;
  --
  --  Set stacks to receive connect events
  --
  Listen_Socket ( Accepting_Socket ) ;
  --
  --  Handle connections
  --
  loop
    --
    --  Wait until client request connect then accept connection
    --
    Accept_Socket ( Accepting_Socket, 
                    Incoming_Socket, Address.all ) ;
    --
    --  Log message, if required
    --
    if LOGGING then
      Put ( "Received From: " ) ;
      Put ( Image ( Address.all ) ) ;
    end if ;
    --
    --  Create a single usage task to handle daemon process
    --  task will die once connection is ended.  In this design 
    --  there is a possible memory leak because once the task
    --  dies there is no memory recover of the dead task.
    --
    Dummy := new Echo ;
    Dummy.Start ( Incoming_Socket ) ;
  end loop ;

exception
  when TCP_Error => 
      Put_Line ( "Error: Server was not initialized" ) ;

  when others => 
      Put_Line ( "Error: Server is beening shutdown" ) ;
      Shutdown_Socket ( Accepting_Socket, Shut_Read_Write ) ;
end Listener ;



In <3b3a796d-50e0-4304-9f8d-295fb2ed0e82@googlegroups.com>, Patrick <patrick@spellingbeewinnars.org> writes:
>
>Hi Everyone
>
>I am setting out to write my first daemon. There seems to be a lot of optio=
>ns for inter-process communication on posix systems. I am planning on desig=
>ning a scientific instrument control server that will control ports, like t=
>he serial port, based on signals it is sent. It will also collect data from=
> instruments and store the data(I was thinking in a postgresql database).
>
>I just need signals passed on one machine so yaml4 seems like overkill. I w=
>as thinking that I could write many little commands, with each command spec=
>ific to an instrument it is designed to control and the daemon as more gene=
>ral infrastructure(basically middleware), so it wouldn't really be a parent=
>/child relationship. I'm guessing plain old pipes are out.
>
>Does FIFO/names pipes sound reasonable for this sort of thing? I am concern=
>ed that with many commands acting on the daemon there will be too much over=
>head with these commands creating file handlers.
>
>I am also going to control instruments over Ethernet anyways so would inves=
>ting time in socket programming solve two problems by making it a socket ba=
>sed server? Once the socket is set up by the daemon, the smaller "satellite=
>" commands would not need as much overhead to connect to a port as they wou=
>ld to create a file handler, would they?
>
>Lastly, this will be done in Ada where ever possible, is there an Ada orien=
>ted way to do this sort of thing?
>
>Thanks for reading-Patrick




^ permalink raw reply	[relevance 4%]

* Ada.Calendar and NTP (and Unix Epoch)
@ 2012-07-23 21:42  5% erlo
  2012-07-23 22:07  0% ` Adam Beneschan
  0 siblings, 1 reply; 200+ results
From: erlo @ 2012-07-23 21:42 UTC (permalink / raw)


The following code raises an ADA.CALENDAR.TIME_ERROR exception:

with Calendar;
with Calendar.Conversions;
with Calendar.Arithmetic;
with Calendar.Formatting;
with Text_IO;
with Ada.Exceptions;

use Calendar;
use Text_IO;


procedure Main is
    AdaTid : Time;
begin
    AdaTid := Conversions.To_Ada_Time(tm_year  => 00,
                                      tm_mon   => 00,
                                      tm_day   => 01,
                                      tm_hour  => 0,
                                      tm_min   => 0,
                                      tm_sec   => 0,
                                      tm_isdst => 0); -- raises exception


    put_line(Formatting.Image(Date                  => AdaTid,
                              Include_Time_Fraction => False,
                              Time_Zone             => 0));

end Main;

This is because Ada.Calendar starts at 1-1-1901. But NTP starts at 
1-1-1900, so how can I work my way around this issue? I need to compare 
NTP time with Unix Epoch based time.

Erlo



^ permalink raw reply	[relevance 5%]

* Re: Ada.Calendar and NTP (and Unix Epoch)
  2012-07-23 21:42  5% Ada.Calendar and NTP (and Unix Epoch) erlo
@ 2012-07-23 22:07  0% ` Adam Beneschan
  0 siblings, 0 replies; 200+ results
From: Adam Beneschan @ 2012-07-23 22:07 UTC (permalink / raw)


On Monday, July 23, 2012 2:42:32 PM UTC-7, erlo wrote:
> The following code raises an ADA.CALENDAR.TIME_ERROR exception:
> 
> with Calendar;
> with Calendar.Conversions;
> with Calendar.Arithmetic;
> with Calendar.Formatting;
> with Text_IO;
> with Ada.Exceptions;
> 
> use Calendar;
> use Text_IO;
> 
> 
> procedure Main is
>     AdaTid : Time;
> begin
>     AdaTid := Conversions.To_Ada_Time(tm_year  => 00,
>                                       tm_mon   => 00,
>                                       tm_day   => 01,
>                                       tm_hour  => 0,
>                                       tm_min   => 0,
>                                       tm_sec   => 0,
>                                       tm_isdst => 0); -- raises exception
> 
> 
>     put_line(Formatting.Image(Date                  => AdaTid,
>                               Include_Time_Fraction => False,
>                               Time_Zone             => 0));
> 
> end Main;
> 
> This is because Ada.Calendar starts at 1-1-1901. But NTP starts at 
> 1-1-1900, so how can I work my way around this issue?

My gut feeling is that if NTP gives you a time in the range 1-1-1900 to 12-31-1900, something is pretty wrong because computers didn't exist during that time period.  So I'm not really sure what the issue is.  I think you need to be more specific about what you're trying to do.  What kind of value is your program using for an "NTP time"--is it an integer, and if so, what does it represent (seconds since 1-1-1900, nanoseconds since 1-1-1900, or what)?  Are you trying to see if an NTP time is less than or greater than a value of Ada.Calendar.Time, or compute the difference in seconds (or something else) between an NTP time value and an Ada.Calendar.Time value, or what?  

                        -- Adam



^ permalink raw reply	[relevance 0%]

* Re: about the new Ada 2012 pre/post conditions
  @ 2012-06-24 19:51  4%                       ` Georg Bauhaus
  0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2012-06-24 19:51 UTC (permalink / raw)


On 24.06.12 18:06, Dmitry A. Kazakov wrote:
> On Sun, 24 Jun 2012 16:59:55 +0200, Georg Bauhaus wrote:
>
>> On 23.06.12 13:01, Dmitry A. Kazakov wrote:
>>> Compare: a contract violation is an *unbounded ERROR*.
>>
>> Do you mean, I should imagine a contract violation that,
>> when checks are turned off, result in erroneous execution?
>
> The effect of contract violation is unbounded because not contracted.

The effect of a contract violation is part of the contract between
client and supplier, by definition, even when it appears to be rather
trivial:

When working under the rules of DbC, a violation that is detected by
the contract checking system must engage the exception mechanism.
This mechanism is supposed to entail a rescuing action, recursively,
or a bail out---and there is LRM 11.6, anyway.

So,

1. if X0 might violate the contract of ADT[*] Y, then X0, or some Xn
    on X0's behalf, must handle the effect of the violation,
    as outlined. There is a guarantee that every (efficiently decidable,
    let us say) violation is detected if (a) checks are on, or
    (b) the proof obligation has had the effect of showing that there
     is no violation, for all inputs.
  
2. Effects of exceptional situations may or may not be expressible
    at all, due to the nature of Ada exceptions that, unfortunately,
    cover both "exceptional situation" and "non-local transfer of
    control". In "exceptional situation", there may not be any form of
    control because this is what the word "exception" means in this
    case: the program can control all situations except those whose
    effects are not known when designing. We would be trying to handle
    Program_Error in advance.


> When you say that something behaves in a certain way under specified
> conditions, e.g. raises exception when out of range, that is the contract.
>
> 1. violation =>  nothing guaranteed
> 2. effect is bounded =>  these bounds are in the contract
>
> 1+2 = contract violation is necessarily *equivalent* to undefined behavior.
>
> What is so difficult about this?

It is a theory in a different universe of notions.


__
[*] A contract as in Design by Contract applies to ADTs only, somewhat like
the full set of different aspects is made for ADTs in Ada 2012.



^ permalink raw reply	[relevance 4%]

* Re: Is Text_IO.Put_Line() thread-safe?
  @ 2012-06-14 21:14  6% ` tmoran
  0 siblings, 0 replies; 200+ results
From: tmoran @ 2012-06-14 21:14 UTC (permalink / raw)


> > It's a good idea to put an exception handler at the bottom of every
> > task body, and do some debugging output there.  Otherwise, an
> > exception will cause the task to silently vanish.  This is a
> > language design flaw.
>
> It would be nice if the exception would propagate in the task's master,

  Not quite the same, but possibly useful:

with Ada.Exceptions;
procedure Testte is
  task type T is
    entry A;
    entry B(I : in Integer);
    entry C;
  end;
  task body T is
    Dummy : Natural := 1;
  begin
    accept A;
    select
      accept C;
    or
      delay 3.0;
    end select;
    Dummy := Dummy - 2; -- cause exception
  exception
    when Surprise: others =>
      declare
        use Ada.Exceptions;
        Ea : Exception_Occurrence_Access := Save_Occurrence(Surprise);
      begin
        select
          accept A do Reraise_Occurrence(Ea.all);end;
        or
          accept B(I : in Integer) do Reraise_Occurrence(Ea.all);end;
        or
          accept C do Reraise_Occurrence(Ea.all);end;
        or
          terminate; -- died and nobody noticed!
        end select;
      end;
  end T;
  This : T;
begin
  This.A;
  This.C;  -- will cause This to have an internal, post-rendezvous, exception
  This.A;  -- The next call on This will get that saved exception
end Testte;



^ permalink raw reply	[relevance 6%]

* Re: understanding runtime support
  @ 2012-05-15 14:48  5% ` Lucretia
  0 siblings, 0 replies; 200+ results
From: Lucretia @ 2012-05-15 14:48 UTC (permalink / raw)


On Friday, May 11, 2012 4:49:07 AM UTC+1, Patrick wrote:

> What is the situation with Ada? I was hoping to target various M68K related architectures, ARM and AVR.

As linked to a number of times, my tamp repo on github (above) has some code that will build for an arm board and can be run on it, doesn't do anything though :D

With Ada, you can pass a number of compilation units to the compiler and it will build them, some of these units can be what is the equivalent of a "main." What GNAT does with this is as follows, gnatbind is called to generate a new file b~<your entry procedure name>.adb, this file contains procedures for calling the elaboration code (to set up arrays and other data), then calls your entry point and on exit calls an exit procedure.

An example is best, so given the following entry point:

procedure test is
   a : string(1 .. 5) := "hello";
begin
   null;
end test;

and compiled with:

$ gnatmake -c test.adb 
gcc-4.6 -c test.adb
$ gnatmake -b test.adb 
gnatbind -x test.ali

you are left with the following b~test.ad[sb]:

pragma Ada_95;
with System;
package ada_main is
   pragma Warnings (Off);

   gnat_argc : Integer;
   gnat_argv : System.Address;
   gnat_envp : System.Address;

   pragma Import (C, gnat_argc);
   pragma Import (C, gnat_argv);
   pragma Import (C, gnat_envp);

   gnat_exit_status : Integer;
   pragma Import (C, gnat_exit_status);

   GNAT_Version : constant String :=
                    "GNAT Version: 4.6" & ASCII.NUL;
   pragma Export (C, GNAT_Version, "__gnat_version");

   Ada_Main_Program_Name : constant String := "_ada_test" & ASCII.NUL;
   pragma Export (C, Ada_Main_Program_Name, "__gnat_ada_main_program_name");

   procedure adafinal;
   pragma Export (C, adafinal, "adafinal");

   procedure adainit;
   pragma Export (C, adainit, "adainit");

   procedure Break_Start;
   pragma Import (C, Break_Start, "__gnat_break_start");

   function main
     (argc : Integer;
      argv : System.Address;
      envp : System.Address)
      return Integer;
   pragma Export (C, main, "main");

   type Version_32 is mod 2 ** 32;
   u00001 : constant Version_32 := 16#2951576a#;
   pragma Export (C, u00001, "testB");
   u00002 : constant Version_32 := 16#ba46b2cd#;
   pragma Export (C, u00002, "system__standard_libraryB");
   u00003 : constant Version_32 := 16#1e2e640d#;
   pragma Export (C, u00003, "system__standard_libraryS");
   u00004 : constant Version_32 := 16#23e1f70b#;
   pragma Export (C, u00004, "systemS");
   u00005 : constant Version_32 := 16#0936cab5#;
   pragma Export (C, u00005, "system__memoryB");
   u00006 : constant Version_32 := 16#e96a4b1e#;
   pragma Export (C, u00006, "system__memoryS");
   u00007 : constant Version_32 := 16#3ffc8e18#;
   pragma Export (C, u00007, "adaS");
   u00008 : constant Version_32 := 16#9229643d#;
   pragma Export (C, u00008, "ada__exceptionsB");
   u00009 : constant Version_32 := 16#e3df9d67#;
   pragma Export (C, u00009, "ada__exceptionsS");
   u00010 : constant Version_32 := 16#95643e9a#;
   pragma Export (C, u00010, "ada__exceptions__last_chance_handlerB");
   u00011 : constant Version_32 := 16#03cf4fc2#;
   pragma Export (C, u00011, "ada__exceptions__last_chance_handlerS");
   u00012 : constant Version_32 := 16#30ec78bc#;
   pragma Export (C, u00012, "system__soft_linksB");
   u00013 : constant Version_32 := 16#e2ebe502#;
   pragma Export (C, u00013, "system__soft_linksS");
   u00014 : constant Version_32 := 16#0d2b82ae#;
   pragma Export (C, u00014, "system__parametersB");
   u00015 : constant Version_32 := 16#bfbc74f1#;
   pragma Export (C, u00015, "system__parametersS");
   u00016 : constant Version_32 := 16#72905399#;
   pragma Export (C, u00016, "system__secondary_stackB");
   u00017 : constant Version_32 := 16#378fd0a5#;
   pragma Export (C, u00017, "system__secondary_stackS");
   u00018 : constant Version_32 := 16#ace32e1e#;
   pragma Export (C, u00018, "system__storage_elementsB");
   u00019 : constant Version_32 := 16#d92c8a93#;
   pragma Export (C, u00019, "system__storage_elementsS");
   u00020 : constant Version_32 := 16#4f750b3b#;
   pragma Export (C, u00020, "system__stack_checkingB");
   u00021 : constant Version_32 := 16#80434b27#;
   pragma Export (C, u00021, "system__stack_checkingS");
   u00022 : constant Version_32 := 16#a7343537#;
   pragma Export (C, u00022, "system__exception_tableB");
   u00023 : constant Version_32 := 16#8120f83b#;
   pragma Export (C, u00023, "system__exception_tableS");
   u00024 : constant Version_32 := 16#ff3fa16b#;
   pragma Export (C, u00024, "system__htableB");
   u00025 : constant Version_32 := 16#cc3e5bd4#;
   pragma Export (C, u00025, "system__htableS");
   u00026 : constant Version_32 := 16#8b7dad61#;
   pragma Export (C, u00026, "system__string_hashB");
   u00027 : constant Version_32 := 16#057d2f9f#;
   pragma Export (C, u00027, "system__string_hashS");
   u00028 : constant Version_32 := 16#6a8a6a74#;
   pragma Export (C, u00028, "system__exceptionsB");
   u00029 : constant Version_32 := 16#86f01d0a#;
   pragma Export (C, u00029, "system__exceptionsS");
   u00030 : constant Version_32 := 16#b012ff50#;
   pragma Export (C, u00030, "system__img_intB");
   u00031 : constant Version_32 := 16#213a17c9#;
   pragma Export (C, u00031, "system__img_intS");
   u00032 : constant Version_32 := 16#dc8e33ed#;
   pragma Export (C, u00032, "system__tracebackB");
   u00033 : constant Version_32 := 16#4266237e#;
   pragma Export (C, u00033, "system__tracebackS");
   u00034 : constant Version_32 := 16#4900ab7d#;
   pragma Export (C, u00034, "system__unsigned_typesS");
   u00035 : constant Version_32 := 16#907d882f#;
   pragma Export (C, u00035, "system__wch_conB");
   u00036 : constant Version_32 := 16#9c0ad936#;
   pragma Export (C, u00036, "system__wch_conS");
   u00037 : constant Version_32 := 16#22fed88a#;
   pragma Export (C, u00037, "system__wch_stwB");
   u00038 : constant Version_32 := 16#b11bf537#;
   pragma Export (C, u00038, "system__wch_stwS");
   u00039 : constant Version_32 := 16#5d4d477e#;
   pragma Export (C, u00039, "system__wch_cnvB");
   u00040 : constant Version_32 := 16#82f45fe0#;
   pragma Export (C, u00040, "system__wch_cnvS");
   u00041 : constant Version_32 := 16#f77d8799#;
   pragma Export (C, u00041, "interfacesS");
   u00042 : constant Version_32 := 16#75729fba#;
   pragma Export (C, u00042, "system__wch_jisB");
   u00043 : constant Version_32 := 16#d686c4f4#;
   pragma Export (C, u00043, "system__wch_jisS");
   u00044 : constant Version_32 := 16#ada34a87#;
   pragma Export (C, u00044, "system__traceback_entriesB");
   u00045 : constant Version_32 := 16#71c0194a#;
   pragma Export (C, u00045, "system__traceback_entriesS");
   u00046 : constant Version_32 := 16#13cbc5a8#;
   pragma Export (C, u00046, "system__crtlS");

   --  BEGIN ELABORATION ORDER
   --  ada%s
   --  interfaces%s
   --  system%s
   --  system.htable%s
   --  system.img_int%s
   --  system.img_int%b
   --  system.parameters%s
   --  system.parameters%b
   --  system.crtl%s
   --  system.standard_library%s
   --  system.exceptions%s
   --  system.exceptions%b
   --  system.storage_elements%s
   --  system.storage_elements%b
   --  system.stack_checking%s
   --  system.stack_checking%b
   --  system.string_hash%s
   --  system.string_hash%b
   --  system.htable%b
   --  system.traceback_entries%s
   --  system.traceback_entries%b
   --  ada.exceptions%s
   --  system.soft_links%s
   --  system.unsigned_types%s
   --  system.wch_con%s
   --  system.wch_con%b
   --  system.wch_cnv%s
   --  system.wch_jis%s
   --  system.wch_jis%b
   --  system.wch_cnv%b
   --  system.wch_stw%s
   --  system.wch_stw%b
   --  ada.exceptions.last_chance_handler%s
   --  ada.exceptions.last_chance_handler%b
   --  system.exception_table%s
   --  system.exception_table%b
   --  system.memory%s
   --  system.memory%b
   --  system.standard_library%b
   --  system.secondary_stack%s
   --  system.soft_links%b
   --  system.secondary_stack%b
   --  system.traceback%s
   --  ada.exceptions%b
   --  system.traceback%b
   --  test%b
   --  END ELABORATION ORDER

end ada_main;

pragma Ada_95;
pragma Source_File_Name (ada_main, Spec_File_Name => "b~test.ads");
pragma Source_File_Name (ada_main, Body_File_Name => "b~test.adb");

package body ada_main is
   pragma Warnings (Off);

   procedure Do_Finalize;
   pragma Import (C, Do_Finalize, "system__standard_library__adafinal");

   Local_Priority_Specific_Dispatching : constant String := "";
   Local_Interrupt_States : constant String := "";

   procedure adainit is
      E13 : Boolean; pragma Import (Ada, E13, "system__soft_links_E");
      E23 : Boolean; pragma Import (Ada, E23, "system__exception_table_E");
      E17 : Boolean; pragma Import (Ada, E17, "system__secondary_stack_E");

      Main_Priority : Integer;
      pragma Import (C, Main_Priority, "__gl_main_priority");
      Time_Slice_Value : Integer;
      pragma Import (C, Time_Slice_Value, "__gl_time_slice_val");
      WC_Encoding : Character;
      pragma Import (C, WC_Encoding, "__gl_wc_encoding");
      Locking_Policy : Character;
      pragma Import (C, Locking_Policy, "__gl_locking_policy");
      Queuing_Policy : Character;
      pragma Import (C, Queuing_Policy, "__gl_queuing_policy");
      Task_Dispatching_Policy : Character;
      pragma Import (C, Task_Dispatching_Policy, "__gl_task_dispatching_policy");
      Priority_Specific_Dispatching : System.Address;
      pragma Import (C, Priority_Specific_Dispatching, "__gl_priority_specific_dispatching");
      Num_Specific_Dispatching : Integer;
      pragma Import (C, Num_Specific_Dispatching, "__gl_num_specific_dispatching");
      Main_CPU : Integer;
      pragma Import (C, Main_CPU, "__gl_main_cpu");
      Interrupt_States : System.Address;
      pragma Import (C, Interrupt_States, "__gl_interrupt_states");
      Num_Interrupt_States : Integer;
      pragma Import (C, Num_Interrupt_States, "__gl_num_interrupt_states");
      Unreserve_All_Interrupts : Integer;
      pragma Import (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
      Zero_Cost_Exceptions : Integer;
      pragma Import (C, Zero_Cost_Exceptions, "__gl_zero_cost_exceptions");
      Detect_Blocking : Integer;
      pragma Import (C, Detect_Blocking, "__gl_detect_blocking");
      Default_Stack_Size : Integer;
      pragma Import (C, Default_Stack_Size, "__gl_default_stack_size");
      Leap_Seconds_Support : Integer;
      pragma Import (C, Leap_Seconds_Support, "__gl_leap_seconds_support");

      procedure Install_Handler;
      pragma Import (C, Install_Handler, "__gnat_install_handler");

      Handler_Installed : Integer;
      pragma Import (C, Handler_Installed, "__gnat_handler_installed");
   begin
      Main_Priority := -1;
      Time_Slice_Value := -1;
      WC_Encoding := 'b';
      Locking_Policy := ' ';
      Queuing_Policy := ' ';
      Task_Dispatching_Policy := ' ';
      Priority_Specific_Dispatching :=
        Local_Priority_Specific_Dispatching'Address;
      Num_Specific_Dispatching := 0;
      Main_CPU := -1;
      Interrupt_States := Local_Interrupt_States'Address;
      Num_Interrupt_States := 0;
      Unreserve_All_Interrupts := 0;
      Zero_Cost_Exceptions := 1;
      Detect_Blocking := 0;
      Default_Stack_Size := -1;
      Leap_Seconds_Support := 0;

      if Handler_Installed = 0 then
         Install_Handler;
      end if;

      System.Exception_Table'Elab_Body;
      E23 := True;
      System.Soft_Links'Elab_Body;
      E13 := True;
      System.Secondary_Stack'Elab_Body;
      E17 := True;
   end adainit;

   procedure adafinal is
   begin
      Do_Finalize;
   end adafinal;

   function main
     (argc : Integer;
      argv : System.Address;
      envp : System.Address)
      return Integer
   is
      procedure initialize (Addr : System.Address);
      pragma Import (C, initialize, "__gnat_initialize");

      procedure finalize;
      pragma Import (C, finalize, "__gnat_finalize");

      procedure Ada_Main_Program;
      pragma Import (Ada, Ada_Main_Program, "_ada_test");

      SEH : aliased array (1 .. 2) of Integer;

      Ensure_Reference : aliased System.Address := Ada_Main_Program_Name'Address;
      pragma Volatile (Ensure_Reference);

   begin
      gnat_argc := argc;
      gnat_argv := argv;
      gnat_envp := envp;

      Initialize (SEH'Address);
      adainit;
      Break_Start;
      Ada_Main_Program;
      Do_Finalize;
      Finalize;
      return (gnat_exit_status);
   end;

--  BEGIN Object file/option list
   --   ./test.o
   --   -L./
   --   -L/usr/lib/gcc/x86_64-linux-gnu/4.6/adalib/
   --   -shared
   --   -lgnat-4.6
--  END Object file/option list   

end ada_main;

Lots of stuff in there, but you get the idea. See the "main" procedure? That call's adainit, then the actual procedure Ada_Main_Program_Name - test.

So, for bare hardware you need to mess around with the gnatbind step like this so that it doesn't generate some stuff, my b~blink.adb main is:

   procedure main is

      procedure Ada_Main_Program;
      pragma Import (Ada, Ada_Main_Program, "_ada_blink");

      Ensure_Reference : aliased System.Address := Ada_Main_Program_Name'Address;
      pragma Volatile (Ensure_Reference);

   begin
      adainit;
      Break_Start;
      Ada_Main_Program;
   end;

I just use the default discovery startup code which calls main from some assembly after setting up the hardware.

Luke.



^ permalink raw reply	[relevance 5%]

* Re: Ada on Nintendo DS ?
  2012-04-28  7:19  4% ` Stephen Leake
@ 2012-04-28 13:43  0%   ` Natasha Kerensikova
  0 siblings, 0 replies; 200+ results
From: Natasha Kerensikova @ 2012-04-28 13:43 UTC (permalink / raw)


On 2012-04-28, Stephen Leake <stephen_leake@stephe-leake.org> wrote:
> Natasha Kerensikova <lithiumcat@gmail.com> writes:
>> As far as I can tell, devkitARM is a toolchain derived from GCC that
>> targets my hardware (it seems there is also some libraries to deal with
>> DSPs and stuff, but I can care about this later on). 
>
> It should be straight-forward to include Ada in that toolchain. The hard
> part will be the Ada runtime library; it assumes some operating system,
> similar to POSIX. It is possible to use no runtime, but then you lose
> some features of Ada (exceptions, fixed point, tasking, new/free, etc).

Well, that's encouraging for a start :-)

Is there some "official" list of what does not have to be supported on
an RTL-less system? The C Standard has the notion of "freestanding" and
"hosted" environments, which basically means without or with libc (which
is quite weaker than POSIX); is there something similar in Ada RM? Or is
it up to the compiler provider to decide what belong to RTL and what is
code generated on bare metal?

For example I'm a bit surprised to see fixed point in the list, when I
would have naively thought appropriate inline code generation would be
enough (exactly like when I did fixed point "by hand" in 386 assembly).

> Is there an OS on the Nintendo?

I would have to double check, but as far as I remember no. There is only
a bootloader that transfers binary code from cartridge storage to memory
and jump to it, and that's it.

An even more fuzzy memory of mine says Nintendo sells a SDK that comes
with most of what you would expect from an OS, but that's not exactly
within hobbyist financial reach.

On the other hand, devkitARM comes with a libnds that might take care of
a reasonable amount of stuff.

>> On the other end, gnatdroid seems to successfully translate Ada code
>> into binary that can be fed to ARM CPUs. 
>
> gnatdroid is intended for Android, a specific operating system. It might
> be useful as an example.

That's all I expected from it, really.

My reasoning was that devkitARM is an example of
C --(1)--> GCC internals --(2)--> Nintendo DS
while gnatdroid is an example of
Ada --(3)--> GCC internals --(4)--> native Android

What I need is just arrows (2) and (3), and I chose gnatdroid for the
argument to lower the risk of stumbling on platform-related variation in
"GCC internals" part. Both are ARM code, and that's the closed target I
have found.

>> Would anyone have an estimation or a bound on how difficult it can be?
> Definitely set a goal of a runtimeless compiler, and see if you can make
> that work. Then think about what parts of the Ada runtime you really
> need.

That was most definitely my plan. First make RTL-less Ada run (which
might not be that easy considering "proving" something runs involves an
output, that require going through DSPs or direct access to LCD or
speakers), then bind divkitARM's libnds, and then the parts of libada I
miss, then celebration about the projet reaching such an incredibly
mature stage, then the rest of libada.

> But it also leads to the Dark Side :). (as in, "I know I can do this
> simple program in C; I'll put off porting Ada just a little longer").

Well remember I'm coming from a decade of allegiance to the Dark Side,
and still find most task to look easier in C (with the notable exception
of debugging low-quality code I have not written), and yet I kept being
irresistibly attracted to the Bright Sparkling Shiny Blinding Side ;-)


Thanks for your help,
Natasha



^ permalink raw reply	[relevance 0%]

* Re: Ada on Nintendo DS ?
  @ 2012-04-28  7:19  4% ` Stephen Leake
  2012-04-28 13:43  0%   ` Natasha Kerensikova
  0 siblings, 1 reply; 200+ results
From: Stephen Leake @ 2012-04-28  7:19 UTC (permalink / raw)


Natasha Kerensikova <lithiumcat@gmail.com> writes:

> Moreover, I just happen to own a device that probably qualifies as
> embedded, with two ARM CPUs (one ARM7 and one ARM9), 4 MB RAM and a few
> DSPs. The device is known as Nintendo DS lite.
>
> So how do I compile code suitable to run on such a device?
>
> I haven't been able to find anything that perform such a task, but I
> have missed it?
>
> As far as I can tell, devkitARM is a toolchain derived from GCC that
> targets my hardware (it seems there is also some libraries to deal with
> DSPs and stuff, but I can care about this later on). 

It should be straight-forward to include Ada in that toolchain. The hard
part will be the Ada runtime library; it assumes some operating system,
similar to POSIX. It is possible to use no runtime, but then you lose
some features of Ada (exceptions, fixed point, tasking, new/free, etc).

Is there an OS on the Nintendo?

> On the other end, gnatdroid seems to successfully translate Ada code
> into binary that can be fed to ARM CPUs. 

gnatdroid is intended for Android, a specific operating system. It might
be useful as an example.

> Would anyone have an estimation or a bound on how difficult it can be?

If Nintendo has a decent operating system, Ada should Just Work (similar
to the ports you describe doing)

But if it doesn't, the level of difficulty really depends on your level
of experience; since you seem to be new at configuring compilers, it
will be hard and confusing :(.

Definitely set a goal of a runtimeless compiler, and see if you can make
that work. Then think about what parts of the Ada runtime you really
need.

> Maybe I should start with smaller steps, like writing C stuff going
> through devkitARM, and then only start aiming at Ada?

That can be useful just to understand how all the tools work together.
In particular, writing a simple program in C, and the same in Ada, can
be instructive in finding out why the Ada compiler isn't doing the right
thing.

But it also leads to the Dark Side :). (as in, "I know I can do this
simple program in C; I'll put off porting Ada just a little longer").

-- 
-- Stephe



^ permalink raw reply	[relevance 4%]

* Re: Does Ada still competitive?
  2012-04-13  9:06  4%     ` anon
@ 2012-04-15  7:00  0%       ` J-P. Rosen
  0 siblings, 0 replies; 200+ results
From: J-P. Rosen @ 2012-04-15  7:00 UTC (permalink / raw)


Le 13/04/2012 11:06, anon@att.net a �crit :
> Taff S. Tucker stated in a number of speeches in the mid 1980s that he 
> did not like the Ada exceptions he preferred the return code of the C 
> procedure which is now apart of Ada 2012 function. So, it goes that Tucker 
> may try to talk the ARG into removing exception data type altogether.
So, your line of reasoning is:

Tucker said something 30 years ago
=> he still believes it
   => he is willing to fight for it
      => he may be pushing the ARG
         => he is pushing the ARG
            => the ARG will remove exceptions

Come on!

Short answer: this did not happen. Full stop.

-- 
J-P. Rosen
Adalog
2 rue du Docteur Lombard, 92441 Issy-les-Moulineaux CEDEX
Tel: +33 1 45 29 21 52, Fax: +33 1 45 29 25 00
http://www.adalog.fr



^ permalink raw reply	[relevance 0%]

* Re: Does Ada still competitive?
  @ 2012-04-13  9:06  4%     ` anon
  2012-04-15  7:00  0%       ` J-P. Rosen
  0 siblings, 1 reply; 200+ results
From: anon @ 2012-04-13  9:06 UTC (permalink / raw)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 11376 bytes --]


Problem with 
Backward Compatibility:

100% backwards compatible is not a cost to be calculated and weighed it 
a requirement for all languages including, the spoken and written human
languages. Only sub-sets of the language can limit the usage of any 
language or statements. And once a word or statement is added it can never 
be deleted or its initial purpose removed. 

So, for an update to any computer language, it must be 100% backwards 
compatible with the previous version of the language.  If not then the 
update is to be known as a "new" language. And this standard is understood 
by all computer language designers, or updaters, like IBM, SUN, Miscrosoft, 
etc.

One example is that FORTRAN still allows the old arithmetic "if" statement 
without any compiler options. Even though most programmers, since FORTRAN 
77 have abandon that statement for the new powerfully "if-then-else" 
statement. But in keeping the old statement does allows FORTRAN to 
maintain its 100% backwards compatible.

And another example is JAVA which complies with this standard law for 
language. Yes it will complains when compiling a JAVA 1.00 routine or 
applet on an updated compiler such as Java 6 but the routine or applet 
will still compile and run. 

Then there Ada, when Ada 83 was updated to Ada 95, first the changes were 
explained in Annex J. "Obsolescent Features". One example was the Ada 
system libraries names, while Ada 83 use parent only names, Ada 95 
introduce parent.child names. Which meant for Ada 95 to be 100% backwards 
compatible in this case that any Ada compiler either had to provide the 
addition of the Ada 83 libraries (Best programming) or just specification 
files containing the routines names with "pragma Interface" (Ada 83) that 
would allow linkage into the Ada 95 libraries using "pragma Export" 
statements on the Ada 95 side, This would also keep any new Ada 95 or future 
features out of Ada 83 code (Good programming). But GNAT just use Ada 95 
with renaming statement which could allow some Ada 95 or later features 
into Ada 83 code (Bad programming). Actually to compile an Ada 83 library 
routine using GNAT way, means that the compiler is in error. An example is 
from "Text_IO.ads":

  pragma Ada_95;
  -------------
  warning pragma is not acknowledge in Ada 83. 
  
  -- Ada 83 only reports non-standardize pragmas RM 2.8. GNAT was not 
  -- available for Ada 83 so "pragma Ada_83" is an Ada 95 implementation
  -- statement. Aka this statement must have no effect on the compiler
  -- while compiling in Ada 83 mode.
  --
  -- note: if accepted under Ada 83 it would allow all feature of 
  -- Ada 95 to be used in Ada 83. (Very Bad programming design)
  -- for any Ada 83 only code

  with Ada.Text_IO;
       -------------
       illegal package name in Ada 83

  package Text_IO renames Ada.Text_IO;
                          -----------
                          illegal package name in Ada 83


In truth using pragma Ada_83 or Ada_95 does not guarantee that the 
GNAT compiler will see the correct version of Ada. And examples of 
this is in overloading the "=" function. In GNAT compiling using Ada 
83 option or pragma Ada_83 an "=" will accept any type. But in RM 83 
( 6.7 ) states the "=" "is only allowed if both parameters are of the 
same limited type." and the result must be Boolean, this was altered 
in Ada 95 to allow any type such as access type with result being any 
type.

An example that will compile in GNAT using "-gnat83"  but Ada 83 RM 
states it should not. So, the GNAT compiler should state:

 function "=" ( Left, Right : Integer_Access ) return Integer_Access ;
                              ---------------         --------------
                           RM 6.7 not a limited type
                           -- not an Ada 83 feature

                                                     RM 6.7 not Boolean
                                                  -- not an Ada 83 feature

Besides the overloading "=" error there is removal of a number of 
pragma statement in Ada 95, which were used by Cray and others in Ada 83. 
So, since Ada 95 is not 100% backwards compatible, so, Ada 95 should be 
classified as a new language that must complete with its predecessor 
Ada 83 but never replace it. 

And a number of changes in "Ada 2005" alters the Ada 95 statements 
which delete the 100% backwards compatible, so Ada 20056 is a new 
language.  And then there "Ada 2012 Corrigendum 1" also know as the 
"correction of errors" for Ada but instead of correcting some error it 
alters external Generic packages a big plus for Ada by replacing the 
"return by reference" by "return by type" causes existing re-usable  
external Generic packages to nolonger compile makes "Ada 2012" a completely 
100% new language that can never be 100% backwards compatible with any 
predecessor Ada 2005, Ada 95 or Ada 83.

So The ARG has not turn Ada language into four similar by different 
languages.

  Ada 83,   (adopted 1987)
  Ada 95,   (adopted 1995)
  Ada 2005, (adopted 2007)
  Ada 2012, (adopted 201?)

And No the ARG can not just pull Ada 83. Once a language has been 
created it there until the end of time. The ARG can only state that it is 
nolonger officially being supported any more by the ARG. But others like 
IBM for one can pick it up. IBM has done this for other languages.

The ARG says that each new Ada is only an upgrade. If that was the case,
then every statement every used in prior Ada version would still be 
operational in the updated version. Like "return by reference", would 
still be usable. And with almost every aspect of Ada now being optional, 
there is no true base standard that one can rely upon to use for the 
language.



Problem with 
Optimization:

Reference any and all "Software Optimization Reference Manual" or any 
chapters in a CPU designer manual's set that deals with Optimization. For 
Intel they use a manual, that can be download from Intel web site. 

 "Intel� 64 and IA-32 Architectures Optimization Reference Manual"

It states that any interruption in the execution stream, such as 
unnecessary verification checks decrease cpu performance and optimization.
Because it can cause the instruction pipelining as well as the memory 
caches to be flushed. And these type of statements can be found in SUN, 
SGI, IBM, and all others CPU manual set. And the "not null" feature is 
unnecessary aka a wasted code if the programmer designs his code 
correctly. Which makes the "not null" more of a high school teaching 
concept that should never be allowed in a language or production line 
compiler or language translator.

But since a number of ARG members are directly associated with Adacore. 
It seams ARG are not too concern with optimization because the 
optimization for GNAT, which is normally in the "Middle End" of a compiler 
is actually performed by the GCC backend which is not apart of GNAT Ada 
code. Plus secondary problem is that Adacode can not guarantee what code 
will be produce by GCC "backend" routines.

And why is this a problem, well through the years a number of GCC versions 
have had issues with processor and code optimization. You can find a few 
papers on file at some major university libraries and a couple on the 
internet. As an example you can find an articles on GCC versions and 
the 128/256-bit multi-precision math packages, stating the package is not 
being optimized correctly on some version of GCC. 

So, should GNAT use GCC backend or should GNAT bypass GCC "backend" and 
have its own "Middle and Back End" routines. For the issue of Ada 
optimization it seams that GNAT should bypass GCC. Because Ada contains 
two options for optimization one is for "Space" and "Time" which both could 
be handled initially in the "Middle end". Where the uncalled routines could 
be removed and then the remaining AST code could be optimize for Time.  
Then later in the binder ("gnatbind") could remove any dead code from 
precompiled Ada library packages, while linking that package, unlike most 
other linkers which just copy the dead code into the program. But in order 
to remove the dead code the binder ("gnatbind") would have to bypass calling 
GCC linkers and preform the link/editing itself while removing the dead code 
from the library packages. And course this removes the constant updating
of GNAT to every new version of GCC, which saves money and time.


As for 2020 and exceptions.

Taff S. Tucker stated in a number of speeches in the mid 1980s that he 
did not like the Ada exceptions he preferred the return code of the C 
procedure which is now apart of Ada 2012 function. So, it goes that Tucker 
may try to talk the ARG into removing exception data type altogether. 
Especially since 2020 might be his last chance to update Ada. And since 
most of the new Ada programmers are those moving from C they have little 
experience in using Ada exceptions so with the C like procedure aka Ada 
function they will not ever miss the power and performance of Ada exceptions 
and handlers.

And at the movement no one can say what changes will occur between adoption 
of 2012 and the adoption of 2020. But with the "return by type" change no
one want to bet on what will not be there.


These are three of a few reason why Ada has become "Obsolete" to most 
software shops and schools.



In <jm5qqp$n1g$1@dont-email.me>, "J-P. Rosen" <rosen@adalog.fr> writes:
>Le 11/04/2012 22:19, anon@att.net a �crit :
><anon header>This is a response to FUD spread as usual by anon, to warn
>people not to believe this nonsense </anon header>
>
>> A second problem is that every year the ARG is moving Ada toward a C like 
>> language. An example is in Ada 2012, is functions now can use "in out" 
>> within the parameter list
>As every C programmer knows, there are no in out parameters in C
>[...]
>
>> Which is classical C version of a procedure routine with the "return_type" 
>> being a error code. So, will the "Exceptions" and exception handler be 
>> next to be removed from Ada in 2020. That's a problem with existing Ada 
>> programmers, being that they may be forced to make 100s of re-writes 
>> to remove exceptions that no one want to do. And the ARG can not say 
>> for certain that exception will exist in Ada 2020 or after, until they 
>> vote on Ada 2020 RM sometime in 2020 or later.
>The ARG is very careful about incompatibilities, and these are
>introduced only when the benefits far outweighs the cost of
>incompatibility. As fas as exceptions are concerned, I challenge you to
>provide a single reference that the ARG ever considered removing them.
>
>> A third is the "Not null" clause that are use in routine's parameter list 
>> starting with Ada 2005.  That cause introduces inefficiency error checking 
>> at the beginning of the routine that can not be truly optimized.
>On the contrary, it replaces many checks in the body of the called
>subprogram by a single check at the call site.
>
>> There are others concepts that software division in companies like NASA 
>> or software shops do not like the direction Ada is going in because of 
>> the ARG.
>Please provide a reference to support that claim (other than your own
>rambling)
>
>-- 
>J-P. Rosen
>Adalog
>2 rue du Docteur Lombard, 92441 Issy-les-Moulineaux CEDEX
>Tel: +33 1 45 29 21 52, Fax: +33 1 45 29 25 00
>http://www.adalog.fr




^ permalink raw reply	[relevance 4%]

* Re: OpenToken: Handling the empty word token
  @ 2012-01-30 16:28  2%   ` mtrenkmann
  0 siblings, 0 replies; 200+ results
From: mtrenkmann @ 2012-01-30 16:28 UTC (permalink / raw)


On Jan 28, 11:46 am, Stephen Leake <stephen_le...@stephe-leake.org>
wrote:
> mtrenkmann <martin.trenkm...@googlemail.com> writes:
> > Very often grammars have so called epsilon-productions where one
> > alternative for a non-terminal symbol points to theemptyword
> > (epsilon).
>
> I've never seen this, but I haven't seen many grammars.
>
Here is the ASN.1 grammar I have to deal with (see Annex L):
http://www.itu.int/rec/T-REC-X.680-200811-I/en

> I would code that as:
>
> Settings <= required_settings + action and
> Settings <= required_settings & optional + action
>
> Which I assume you are doing as a workaround for what you want.
>
> Supporting epsilon is an interesting idea. It does reduce the amount of
> user-written code, especially when there is more than one optional part.
>
This is exactly why I need epsilon token support in the RHS of a
production. If you look at the top-level production in ASN.1, namely
"ModuleDefinition", there are already 4 optional non-terminals (the
epsilon token is called "empty" here). Modeling the epsilon token at
that higher level means to provide 2^4 RHS combinations for
"ModuleDefinition". No good!

> > Is there a way to instrument the parser to silently accept the epsilon
> > token whenever it expects it without consuming a token from the lexer,
>
> It's been a while since I messed withOpenTokenat that level, but it
> looks like you could make this happen by changingopentoken-recognizer-nothing.adb Analyze to report Verdict := Matches.
> You might give that a try.
>
> I suspect this would have the problem that Dmitry pointed out; the
> epsilon token would always match, so you'd get lots of ambiguities.
>
I tried it and yes I got lots of ambiguities.

> To get rid of the ambiguities, you would need to feed information about
> what the parser expects into the lexer, so Epsilon would only match if
> the parser expects it. That is possible, but there's no formal mechanism
> for it inOpenToken.
>
> You could define a new token type Epsilon, modeled on Nothing, and add a
> Set_Expected procedure. Then call that from somewhere inopentoken-production-parser-lalr.adb Parse; probably just before each
> call to Find_Next. The list of expected tokens is given by the functionopentoken-production-parser-lalr.adb Expecting (currently used in error
> messages).
>
Sounds feasible to me. I will implement that and let you know.

> -- Stephe

Ok, thanks for all your helpful hints. In the meanwhile I came up with
the following workaround, that actually works fine.
The idea is to perform some kind of recovery in the Parse procedure if
Action.Verb = Error due to the missing of the epsilon token. In that
case I check if epsilon is one of the expected tokens, and if so I set
Current_State.Seen_Token to epsilon and prevent the parser from
reading a new token from the lexer in the next Shift step. Here is the
code with the important parts:

-- The epsilon token becomes a new generic constant of the lexer.
generic
   Last_Terminal : in Token_ID := Token_ID'Last;
   Epsilon_Token : in Token_ID;
package OpenToken.Token.Enumerated.Analyzer is
   -- new function needed by the parser
   function Get_Syntax (Analyzer : in Instance) return Syntax;
   function Epsilon_ID (Analyzer : in Instance) return Terminal_ID;
end OpenToken.Token.Enumerated.Analyzer;

-- This is no complete code! Just the important parts.
package body OpenToken.Production.Parser.LALR is
   overriding procedure Parse (Parser : in out Instance) is
      -- a flag to prevent the parser from reading a new token in
Shift step
      Get_Next_From_Analyzer : Boolean := True;
   begin
      loop
         case Action.Verb is
         when Shift =>
            if Get_Next_From_Analyzer then
               --  Get the next token
               begin
                  Tokenizer.Find_Next (Parser.Analyzer);
               exception
                  when E : Syntax_Error =>
                     raise Syntax_Error with
                     Integer_Image (Line (Parser)) &
                     ":" &
                     Integer_Image (Column (Parser) - 1) &
                     " " &
                     Ada.Exceptions.Exception_Message (E);
               end;
            else
               -- Use the current token again in the next call of
Action_For
               Get_Next_From_Analyzer := True;
            end if;
         when Error =>
            -- BEGIN epsilon token hack
            -- Try to recover if epsilon is one of the expected tokens
            declare
               use Token;
               Expected_Tokens : constant Token_Array
                 := Expecting (Parser.Table, Current_State.State);
               Is_Epsilon_Expected : Boolean := False;
            begin
               for I in Expected_Tokens'Range loop
                  if Expected_Tokens (I) = Tokenizer.Epsilon_Token
then
                     Is_Epsilon_Expected := True;
                     exit;
                  end if;
               end loop;
               if Is_Epsilon_Expected then
                  -- Create an on-demand epsilon token
                  Current_State.Seen_Token := new
Token.Class'(Parser.Analyzer.Get_Syntax
(Parser.Analyzer.Epsilon_ID).Token_Handle.all);
                  Get_Next_From_Analyzer := False;
            -- END epsilon token hack
               else
                  -- Clean up
                  -- Raise Sytax_Error
               end if;
            end;
         end case;
      end loop;
end OpenToken.Production.Parser.LALR;

I am wondering if that behavior cannot be implemented in the table-
lookup procedure. That is when I call Action_For with an unexpected
token, while there is the epsilon as one of the expected tokens, then
this epsilon could be accepted automatically, the parser changes its
state accordingly, and the unexpected token is checked again. Don't
know if that is possible, since I am not yet familiar with the
internals of table-driven parsing.

-- Martin



^ permalink raw reply	[relevance 2%]

* Re: Does OpenToken support Unicode
  2012-01-23 22:48  4%   ` mtrenkmann
@ 2012-01-24 13:47  0%     ` Stephen Leake
  0 siblings, 0 replies; 200+ results
From: Stephen Leake @ 2012-01-24 13:47 UTC (permalink / raw)


mtrenkmann <martin.trenkmann@googlemail.com> writes:

> Just for closing this thread, here is what I have done.

Thanks for the update.

> Beginning at the Text_Feeder level I changed all occurences of
> Character/String variables that are involved in storing parsing data
> (buffers, lexemes, etc) to the Wide_Wide_Character/Wide_Wide_String
> type.
>
> Then I provided a derivation of Text_Feeder that read UTF-8
> (multibyte) characters from Ada.Text_IO and decode them into
> Wide_Wide_Characters. The decoding is currently based on
> System.WCh_Con (GNAT).
>
> As mentioned by Stephe I also tried to implement a generic solution
> regarding the character type, but that wasn't completely possible. For
> instance in the top-level OpenToken package there are constants for
> EOL and EOF that are of type Character. 

Yes, that's an annoying hack. You could try moving them down lower.

> Text_Feeder.Text_IO uses Ada.Text_IO.Get_Line which is not generic.

You'd have to write a generic wrapper for Ada.Text_IO. That might be
useful in other contexts, but it is a lot of work.

> Furthermore, as far as I know, Ada exceptions cannot carry
> Wide_Wide_Strings to report the lexemes of unexpected tokens ...

True, but they can carry UTF-8.

> To support constants and non-generic Ada procedures one has to turn
> them into formal parameters of generic OpenToken packages, right?

Right.

> Maybe this could end in an generics instantiation nightmare. 

Well, complicated anyway :).

> This let me come to the question why in Ada are some packages prefixed
> with Wide_Wide_ and not generic. (Sorry for this question, but a come
> from the C++ universe.)

Good point. For example, Elementary_Functions is generic, and
instantiations are provided for the various float types.

There may be a problem with the functions that convert to other string
types, but those could be moved to child packages.

-- 
-- Stephe



^ permalink raw reply	[relevance 0%]

* Re: Does OpenToken support Unicode
  @ 2012-01-23 22:03  4%   ` mtrenkmann
  2012-01-23 22:48  4%   ` mtrenkmann
  1 sibling, 0 replies; 200+ results
From: mtrenkmann @ 2012-01-23 22:03 UTC (permalink / raw)


Just for closing this thread, here is what I have done.

Beginning at the Text_Feeder level I changed all occurences of
Character/String variables that are involved in storing parsing data
(buffers, lexemes, etc) to the Wide_Wide_Character/Wide_Wide_String
type.

Then I provided a derivation of Text_Feeder that reads UTF-8 (multi-
byte) characters from Ada.Text_IO and decode them into
Wide_Wide_Characters. The decoding is currently based on
System.WCh_Con (GNAT).

As mentioned by Stephe I also tried to implement a generic solution
regarding the character type, but that wasn't completely possible. For
instance in the top-level OpenToken package there are constants for
EOL and EOF that are of type Character. Text_Feeder.Text_IO uses
Ada.Text_IO.Get_Line which is not generic. Furthermore, as far as I
know, Ada exceptions cannot carry Wide_Wide_Strings to report the
lexemes of unexpected/unrecognized tokens ...

To support constants and non-generic Ada procedures one has to turn
them into formal parameters of generic OpenToken packages, right?
Maybe this could end in an generics instantiation nightmare. This let
me come to the question why in Ada are some packages prefixed with
Wide_Wide_ and not generic. (Sorry for this question, but a come from
the C++ universe.)

Ok, thanks again for your previous hints. If there is any interest I
will provide the modified OpenToken code with UTF-8 support after
finishing my thesis.

-- Martin



^ permalink raw reply	[relevance 4%]

* Re: Does OpenToken support Unicode
    2012-01-23 22:03  4%   ` mtrenkmann
@ 2012-01-23 22:48  4%   ` mtrenkmann
  2012-01-24 13:47  0%     ` Stephen Leake
  1 sibling, 1 reply; 200+ results
From: mtrenkmann @ 2012-01-23 22:48 UTC (permalink / raw)


Just for closing this thread, here is what I have done.

Beginning at the Text_Feeder level I changed all occurences of
Character/String variables that are involved in storing parsing data
(buffers, lexemes, etc) to the Wide_Wide_Character/Wide_Wide_String
type.

Then I provided a derivation of Text_Feeder that read UTF-8
(multibyte) characters from Ada.Text_IO and decode them into
Wide_Wide_Characters. The decoding is currently based on
System.WCh_Con (GNAT).

As mentioned by Stephe I also tried to implement a generic solution
regarding the character type, but that wasn't completely possible. For
instance in the top-level OpenToken package there are constants for
EOL and EOF that are of type Character. Text_Feeder.Text_IO uses
Ada.Text_IO.Get_Line which is not generic. Furthermore, as far as I
know, Ada exceptions cannot carry Wide_Wide_Strings to report the
lexemes of unexpected tokens ...

To support constants and non-generic Ada procedures one has to turn
them into formal parameters of generic OpenToken packages, right?
Maybe this could end in an generics instantiation nightmare. This let
me come to the question why in Ada are some packages prefixed with
Wide_Wide_ and not generic. (Sorry for this question, but a come from
the C++ universe.)

Ok, thanks again for your previous hints. If there is any interest I
will provide the modified OpenToken code with UTF-8 support after
finishing my thesis.

-- Martin



^ permalink raw reply	[relevance 4%]

* Tracing procedural calls when an exception is raised
@ 2012-01-20 15:03  5% tonyg
  0 siblings, 0 replies; 200+ results
From: tonyg @ 2012-01-20 15:03 UTC (permalink / raw)



When using the gnat compiler is there a way to get hold of the
procedure or function stack when an exception is called.

I am using at the moment

 Ada.Exceptions.Exception_Information(Error)

within an exception handler and I am looking for better information



^ permalink raw reply	[relevance 5%]

* Re: XMLAda and GDB on Lion anybody?
  @ 2011-08-04 12:04  4% ` Simon Wright
  0 siblings, 0 replies; 200+ results
From: Simon Wright @ 2011-08-04 12:04 UTC (permalink / raw)


MRE <Marc.Enzmann@web.de> writes:

> I am experimenting with XMLAda, following AdaCore's manual.
>
> When running the example given on pages 22 and 23 (DomExample2), I get
> the following exception:
>
> raised CONSTRAINT_ERROR : dom-core-nodes.adb:237 access check failed
>
> as soon as the line
>
> List := Get_Elements_By_Tag_Name (Doc, "pref");
>
> is reached.
>
> I have not really an idea what the problem might be, as I can't debug
> properly, GDB telling me
>
> unable to read unknown load command 0x24
> unable to read unknown load command 0x26
>
> Is it just me, or has anybody else seen this too?

When I run the example (with no changes, using GNAT GPL 2011) it works
just fine :-).

However, (a) it's much better to debug using static libraries, (b) Lion
has made a sgnificant change to linking an executable, in that the
default behaviour is now to create position-independent executables
which can be loaded into store at random addresses to defeat malware.

I find I can run domexample2 under the debugger (including the ability
to set catchpoints for exceptions and breakpoints) by

   $ gnatmake -P default domexample2.adb -g -XLIBRARY_TYPE=static \
      -largs -Wl,-no_pie

This still gives the warnings about load commands...

$ gdb domexample2
GNU gdb (GDB) 7.2 for GNAT GPL 2011 (20110419) [rev=gdb-7.2-ref-110-g8cd875d]
Copyright (C) 2010 Free Software Foundation, Inc.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
See your support agreement for details of warranty and support.
If you do not have a current support agreement, then there is absolutely
no warranty for this version of GDB.  Type "show copying"
and "show warranty" for details.
This GDB was configured as "x86_64-apple-darwin10.2.0".
For bug reporting instructions, please see:
<http://www.gnu.org/software/gdb/bugs/>...
unable to read unknown load command 0x24
unable to read unknown load command 0x26
unable to read unknown load command 0x24
unable to read unknown load command 0x26
Reading symbols from /Users/simon/xmlada-4.1-src/docs/dom/domexample2...
warning: can't find section '*UND*' in OSO file /Users/simon/xmlada-4.1-src/sax/lib/static/libxmlada_sax.a(sax-encodings.o)
done.
(gdb) b exception
Catchpoint 1: all Ada exceptions
(gdb) b domexample2.adb:30
Breakpoint 2 at 0x1000018ca: file /Users/simon/xmlada-4.1-src/docs/dom/domexample2.adb, line 30.
(gdb) run
Starting program: /Users/simon/xmlada-4.1-src/docs/dom/domexample2 
unable to read unknown load command 0x24
unable to read unknown load command 0x26

Breakpoint 2, domexample2 ()
    at /Users/simon/xmlada-4.1-src/docs/dom/domexample2.adb:30
30	   List := Get_Elements_By_Tag_Name (Doc, "pref");
(gdb) b dom-core-nodes.adb:237
Breakpoint 3 at 0x100007ca1: file /Users/simon/xmlada-4.1-src/dom/dom-core-nodes.adb, line 237.
(gdb) c
Continuing.

Breakpoint 3, dom.core.nodes.child_nodes (n=0x100200c50)
    at /Users/simon/xmlada-4.1-src/dom/dom-core-nodes.adb:237
237	      case N.Node_Type is
(gdb) c
Continuing.

Breakpoint 3, dom.core.nodes.child_nodes (n=0x100200d50)
    at /Users/simon/xmlada-4.1-src/dom/dom-core-nodes.adb:237
237	      case N.Node_Type is
(gdb) c
Continuing.

Breakpoint 3, dom.core.nodes.child_nodes (n=0x100200df0)
    at /Users/simon/xmlada-4.1-src/dom/dom-core-nodes.adb:237
237	      case N.Node_Type is
(gdb) del 3
(gdb) c
Continuing.
Value of "pref1" is Value1
Value of "pref2" is Value2

Program exited normally.
(gdb) 



^ permalink raw reply	[relevance 4%]

* Aspect programming
@ 2011-07-27 16:29  5% Anh Vo
  0 siblings, 0 replies; 200+ results
From: Anh Vo @ 2011-07-27 16:29 UTC (permalink / raw)


If I understand the ARM 2012 and Ada 2012 Rationale correctly, the
following test code should raise Ada.Assertions.Assertion_Error.
However, Stack_Error is raised instead. I am using GNAT-GPL-2011. Is
it my bug or compiler's bug?


pragma Assertion_Policy (Check);
--  pragma Check_Policy (Postconditions, On);
--  pragma Check_Policy (Preconditions, On);

with Ada.Assertions;
with Ada.Text_Io;
with Ada.Exceptions;
with Stacks;

procedure Aspect_Programming_Test is

   use Ada;
   use Text_Io;

   package Int_Stacks is new Stacks (Integer);
   My_Int_Stack : Int_Stacks.Stack;
   My_Int : Integer := -1;

begin
   Put_Line ("Learning Aspect-Oriented Software Programming");

   for Index in 1 .. 10 loop
      My_Int_Stack.Push (Index);
   end loop;

   Put_Line ("Next Push operation will trigger Stack Full problem /
exception");
   My_Int_Stack.Push (1);

   for Index in 1 .. 10 loop
      My_Int_Stack.Pop (My_Int);
   end loop;

   Put_Line ("Next Pop operation will trigger Stack Empty problem /
exception");
   My_Int_Stack.Pop (My_Int);

exception
   when Ada.Assertions.Assertion_Error =>
      Put_Line ("Pragma Assertion_Policy is in effect");

   when Error : Int_Stacks.Stack_Error =>
      Put_Line ("Pragma Assertion_Policy is ignored");
      Put_Line (Exceptions.Exception_Information (Error));

   when Error : others =>
      Put_Line ("Let's see what is going on => ");
      Put_Line (Exceptions.Exception_Information (Error));

end Aspect_Programming_Test;

generic
   type Item is private;
   Size : Positive := 10;
package Stacks is

   type Stack is tagged private;

   function Is_Empty (S : Stack) return Boolean;

   function Is_Full (S : Stack) return Boolean;

   procedure Push (S : in out Stack;
                   X : in     Item)
      with Pre => not Is_Full (S),
           Post => not Is_Empty (S);

   procedure Pop (S : in out Stack;
                  X :    out Item)
      with Pre => not Is_Empty (S),
           Post => not Is_Full (S);

   Stack_Error: exception;

private

   type Data_Array is array (Natural Range 1 .. Size) of Item;

   type Stack is tagged record
      Data : Data_Array;
      Index : Positive := 1;
   end record;

   function Current_Items (S : Stack) return Natural;

end Stacks;

pragma Assertion_Policy (Check);

package body Stacks is

   protected Mutex is -- Mutex object section starts
      entry Take;
      procedure Release;
   private
      Resource_Available : Boolean := True;
   end Mutex;
   protected body Mutex is
      entry Take when Resource_Available is
      begin
         Resource_Available := False;
      end Take;

      procedure Release is
      begin
         Resource_Available := True;
      end Release;
   end Mutex;  -- Mutex object section ends

   function Is_Empty (S : Stack) return Boolean is
      Condition : Boolean := True;
   begin
      Mutex.Take;
      Condition := S.Index = 1;
      Mutex.Release;
      return Condition;
   end Is_Empty;

   function Is_Full (S : Stack) return Boolean is
      Condition : Boolean := True;
   begin
      Mutex.Take;
      Condition := S.Index = Size + 1;
      Mutex.Release;
      return Condition;
   end Is_Full;

   procedure Push (S : in out Stack;
                   X : in     Item)  is
   begin
      Mutex.Take;
      if S.Index = Size + 1 then
         Mutex.Release;
         raise Stack_Error with "Stack is full!!!";
      end if;
      S.Data(S.Index) := X;
      S.Index := S.Index + 1;
      Mutex.Release;
   end Push;

   procedure Pop (S : in out Stack;
                  X :    out Item)  is
   begin
      Mutex.Take;
      if S.Index = 1 then
         Mutex.Release;
         raise Stack_Error with "Stack is empty!!!";
      end if;
      S.Index := S.Index - 1;
      X := S.Data(S.Index);
      Mutex.Release;
   end Pop;

   function Current_Items (S : Stack) return Natural is
      Items_Count : Natural := 0;
   begin
      Mutex.Take;
      Items_Count := S.Index - 1;
      Mutex.Release;
      return Items_Count;
   end Current_Items;

end Stacks;



^ permalink raw reply	[relevance 5%]

* Re: Text parsing package
  @ 2011-03-23 11:19  5%   ` Syntax Issues
  0 siblings, 0 replies; 200+ results
From: Syntax Issues @ 2011-03-23 11:19 UTC (permalink / raw)


Thanks for posting the techniques Dmitry. I am going to try
implementing as many as I can -- I am still a fairly new programmer,
and I still have a lot to learn.
Right now it uses text_io and strings.unbounded.text_io (this is
probably bad :/) and only works with files. I tried to make it as
simple as possible with exception checking -- global booleans are set
and checked by the running program.
-- Spec
with
	Ada.Exceptions,
	Ada.Text_Io,
	Ada.Strings.Unbounded.Text_Io,
	Ada.Strings.Unbounded;
use
	Ada.Exceptions,
	Ada.Text_Io,
	Ada.Strings.Unbounded.Text_Io,
	Ada.Strings.Unbounded;
package Parsing
	is
	---------------
	-- Constants --
	---------------
		DEBUGGING_ON                  : constant Boolean          := true;
		EXCEPTION_PARSE_NOTHING       : constant String           :=
"Attempted to parse passed the end-of-file.";
		EXCEPTION_PARSE_UNOPENED_FILE : constant String           :=
"Attempted to parse an unopened file.";
		EXCEPTION_PARSE_NON_NUMBER    : constant String           := "Failed
to parse a number.";
		NULL_STRING_FIXED             : constant String           := "";
		NULL_STRING_UNBOUNDED         : constant Unbounded_String :=
To_Unbounded_String(NULL_STRING_FIXED);
	--------------
	-- Packages --
	--------------
		package Io_Integer
			is new Ada.Text_Io.Integer_Io(Integer);
		package Io_Float
			is new Ada.Text_Io.Float_Io(Float);
	---------------
	-- Variables --
	---------------
		Error_On_Recent_Operation  : Boolean          := false;
		Error_Occured_Parsing_File : Boolean          := false;
		Line                       : Unbounded_String :=
NULL_STRING_UNBOUNDED;
		File                       : File_Type;
	-----------------
	-- Subprograms --
	-----------------
		procedure Open
			(Name : in String);
			pragma Inline(Open);
		procedure Close;
			pragma Inline(Close);
		function Next_Unbounded_String
			return Unbounded_String;
		function Next_String
			return String;
			pragma Inline(Next_String);
		function Next_Integer
			return Integer;
		function Next_Float
			return Float;
	end Parsing;
--- Body
package body Parsing
	is
	--
	-- Open_File
	--
	procedure Open
		(Name : in String)
		is
		begin
			Ada.Text_Io.Open(File, In_File, Name);
			if not End_Of_File(File) then
				Line := Get_Line(File);
			end if;
		end Open;
	--
	-- Close_File
	--
	procedure Close
		is
		begin
			if Is_Open(File) then
				Ada.Text_Io.Close(File);
				Error_Occured_Parsing_File := false;
			end if;
		end Close;
	--
	-- Next_Unbounded_String
	--
	function Next_Unbounded_String
		return Unbounded_String
		is
		Result : Unbounded_String := NULL_UNBOUNDED_STRING;
		begin
			Error_On_Recent_Operation := false;
			Trim(Line, Ada.Strings.Both);
			if not Is_Open(File) then
				if DEBUGGING_ON then
					Put_Line(EXCEPTION_PARSE_UNOPENED_FILE);
				end if;
				Error_Occured_Parsing_File := true;
				Error_On_Recent_Operation  := true;
				return Result;
			end if;
			loop
				if Length(Line) /= 0 then
					for I in 1..Length(Line) loop
						if Element(Line, I) = ' ' or I = Length(Line) then
							Result := To_Unbounded_String(Slice(Line, 1, I));
							Delete(Line, 1, I);
							return Result;
						end if;
					end loop;
				else
					if End_Of_File(File) then
						if DEBUGGING_ON then
							Put_Line(EXCEPTION_PARSE_NOTHING);
						end if;
						Error_Occured_Parsing_File := true;
						Error_On_Recent_Operation  := true;
						return Result;
					end if;
					Line := Trim(Get_Line(File), Ada.Strings.Both);
				end if;
			end loop;
		end Next_Unbounded_String;
	--
	-- Next_String
	--
	function Next_String
		return String
		is
		begin
			return To_String(Next_Unbounded_String);
		end Next_String;
	--
	-- Next_Integer
	--
	function Next_Integer
		return Integer
		is
		Last   : Positive;
		Result : Integer := 0;
		begin
			Io_Integer.Get(To_String(Next_Unbounded_String), Result, Last);
			return Result;
			exception
				when Data_Error | Constraint_Error =>
					if DEBUGGING_ON then
						Put_Line(EXCEPTION_PARSE_NON_NUMBER);
					end if;
					Error_Occured_Parsing_File := true;
					Error_On_Recent_Operation  := true;
					return Result;
		end Next_Integer;
	--
	-- Next_Float
	--
	function Next_Float
		return Float
		is
		Last   : Positive;
		Result : Float := 0.0;
		begin
			Io_Float.Get(To_String(Next_Unbounded_String), Result, Last);
			return Result;
			exception
				when Data_Error | Constraint_Error =>
					if DEBUGGING_ON then
						Put_Line(EXCEPTION_PARSE_NON_NUMBER);
					end if;
					Error_Occured_Parsing_File := true;
					Error_On_Recent_Operation  := true;
					return Result;
		end Next_Float;
	end Parsing;



^ permalink raw reply	[relevance 5%]

* Re: Forcing Exception Handling
  2011-03-01  9:51  5%         ` Dmitry A. Kazakov
@ 2011-03-01 10:07  0%           ` iloAda
  0 siblings, 0 replies; 200+ results
From: iloAda @ 2011-03-01 10:07 UTC (permalink / raw)


On Mar 1, 10:51 am, "Dmitry A. Kazakov" <mail...@dmitry-kazakov.de>
wrote:
> On Tue, 1 Mar 2011 01:34:02 -0800 (PST), iloAda wrote:
> > Mmmmmm...That's what I was fearing!!
> > Actually the idea behind my question was that I'm working on a real
> > time system, and as u know, we can't afford to a let a real time
> > system crash because of an unhandled exception.
>
> So long it crashes in real time everything is OK! (:-)) You meant rather
> mission-critical system, I guess.
>
> > Since I use some other
> > libraries in my system (that weren't written by myself or anybody else
> > I know) that will raise exceptions, I wanted to be forced to handle
> > them.
>
> You should use some static analysis tool for that. E.g. SPARK.
>
> > exception
> >  When others =>
> >      --  Do something that will allow the system to keep on running
>
> That is of course meaningless, because you don't know WHAT happened in
> order to determine the SOMETHING to be done.
>
> > have u guys done something like that before?
>
> No, because see above. The most close thing is:
>
>   when Error : others =>
>       Trace ("Fatal:" & Ada.Exceptions.Exception_Information (Error));
> +/-  raise;
>
> --
> Regards,
> Dmitry A. Kazakovhttp://www.dmitry-kazakov.de

Ok, thanks a lot guys!!

Elie



^ permalink raw reply	[relevance 0%]

* Re: Forcing Exception Handling
  @ 2011-03-01  9:51  5%         ` Dmitry A. Kazakov
  2011-03-01 10:07  0%           ` iloAda
  0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2011-03-01  9:51 UTC (permalink / raw)


On Tue, 1 Mar 2011 01:34:02 -0800 (PST), iloAda wrote:

> Mmmmmm...That's what I was fearing!!
> Actually the idea behind my question was that I'm working on a real
> time system, and as u know, we can't afford to a let a real time
> system crash because of an unhandled exception.

So long it crashes in real time everything is OK! (:-)) You meant rather
mission-critical system, I guess.

> Since I use some other
> libraries in my system (that weren't written by myself or anybody else
> I know) that will raise exceptions, I wanted to be forced to handle
> them.

You should use some static analysis tool for that. E.g. SPARK.

> exception
>  When others =>
>      --  Do something that will allow the system to keep on running

That is of course meaningless, because you don't know WHAT happened in
order to determine the SOMETHING to be done.

> have u guys done something like that before?

No, because see above. The most close thing is:

  when Error : others =>
      Trace ("Fatal:" & Ada.Exceptions.Exception_Information (Error));
+/-  raise;

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de



^ permalink raw reply	[relevance 5%]

* Re: User Defined Storage Pool : Example
  @ 2011-01-22  9:47  4% ` anon
  0 siblings, 0 replies; 200+ results
From: anon @ 2011-01-22  9:47 UTC (permalink / raw)


-- referance delete for spacing


-- Found on www.adapower.com
--
-- http://www.adapower.com/index.php?Command=Class&ClassID=Advanced&CID=222
--
-- Files:
--        memory_management-test.adb
--        memory_management-support.ads
--        memory_management-support.adb
--        memory_management.ads
--        memory_management.adb
--
-- To compile and run:
-- 
--   >gnat make memory_management-test.adb
--   >memory_management-test

--
--  Memory Management with Storage Pools (Anh Vo)
--
--  Memory management can cause real headache due to memory leakage over 
--  time. That is, memory allocation is not properly deallocated after the 
--  call. When the memory runs out, the result could be catastrophic for 
--  some applications. This problem can be recued by garbage collector 
--  built-in the compiler such as Java. However, the cost of run-time 
--  overhead is high.
     
--  Here comes Ada 95 to the recue. How is it possible you may ask? Ah! 
--  Ada 95 provides a feature called Storage Pool. It allows the users 
--  have total control over the memory management. Best of all, it does 
--  not involve run-time overhead as garbage collector. When it is 
--  combined with controlled type, the memory leakage problem is history.
    
--  As shown in the test case, 100 storage elements were allocated 
--  initially. Then, these storage elements are reused again and again. It 
--  is pretty cool isn't it? Enjoy.
     

--------------------------------------------
-- File => memory_management-test.adb
--
with Ada.Finalization ;
with Ada.Text_Io ;
with Memory_Management.Support ;
     
procedure Memory_Management.Test is
    use Ada ;
    use Text_Io ;
     
begin
     
  Put_Line ("********* Memory Control Testing Starts **********") ;
   
  for Index in 1 .. 10 loop
    declare
      David_Botton : Support.General_Data ;
      Nick_Roberts : Support.General_Data ;
      Anh_Vo       : Support.General_Data ;
     
    begin
      David_Botton := ( Finalization.Controlled with
                         Id   => new Integer' ( 111 ), 
                         Name => new String' ( "David Botton" ) ) ;

      Nick_Roberts := ( Finalization.Controlled with
                          Id   => new Integer' ( 222 ), 
                          Name => new String' ( "Nick Roberts" ) ) ;

      Anh_Vo := ( Finalization.Controlled with
                    Id   => new Integer' ( 333 ),
                    Name => new String' ( "Anh Vo" ) ) ;
    end ;
  end loop ;
     
  Put_Line ( "Memory Management Test Passes" ) ;
     
exception
  when others =>
    Put_Line ( "Memory Management Test Fails" ) ;
     
end Memory_Management.Test ;


--------------------------------------------
-- File => memory_management-support.ads
--
with Ada.Finalization ;
     
package Memory_Management.Support is
     
  use Ada ;
     
  -- Adjust the storage size according to the application
  Big_Pool : User_Pool ( Size => 100 )  ;
     
  type Int_Acc is access Integer ;
    for Int_Acc'Storage_Pool use Big_Pool ;
     
  type Str_Acc is access all String ;
    for Str_Acc'Storage_Pool use Int_Acc'Storage_Pool ;
     
  type General_Data is new Finalization.Controlled 
         with record
                Id : Int_Acc ;
                Name : Str_Acc ;
              end record ;
     
  procedure Initialize ( Object : in out General_Data )  ;
     
  procedure Finalize ( Object : in out General_Data )  ;
     
end Memory_Management.Support ;
     

--------------------------------------------
-- File => memory_management-support.adb
--
with Ada.Unchecked_Deallocation ;
     
package body Memory_Management.Support is
     
  procedure Free is new Ada.Unchecked_Deallocation 
                                                 ( Integer, Int_Acc ) ;
  procedure Free is new Ada.Unchecked_Deallocation
                                                  ( String, Str_Acc ) ;
     
   procedure Initialize ( Object : in out General_Data ) is
     begin
       null ;
     end Initialize ;
     
  procedure Finalize ( Object : in out General_Data ) is
    begin
      Free ( Object.Id ) ;
      Free ( Object.Name ) ;
    end Finalize ;
     
end Memory_Management.Support ;
     
--------------------------------------------     
-- File => memory_management.ads
--
with System.Storage_Pools ;
with System.Storage_Elements ;
     
package Memory_Management is
     
    use System ;
    use Storage_Elements ;
    use Storage_Pools ;
     
  type User_Pool ( Size : Storage_Count ) is new
                                       Root_Storage_Pool with private ;
     
  procedure Allocate ( Pool                     : in out User_Pool ;
                       Storage_Address          :    out Address   ;
                       Size_In_Storage_Elements : in Storage_Count ;
                       Alignment                : in Storage_Count ) ;
     
  procedure Deallocate 
                      ( Pool                     : in out User_Pool ;
                        Storage_Address          : in     Address   ;
                        Size_In_Storage_Elements : in Storage_Count ;
                        Alignment                : in Storage_Count ) ;
     
  function Storage_Size ( Pool : in User_Pool ) 
               return Storage_Count ;
     
  -- Exeption declaration

  Memory_Exhausted : exception ;
     
  Item_Too_Big : exception ;
     
private
  type User_Pool ( Size : Storage_Count ) is new Root_Storage_Pool
           with record
                  Data       : Storage_Array ( 1 .. Size ) ;
                  Addr_Index : Storage_Count := 1 ;
                end record ;
     
end Memory_Management ;
     

--------------------------------------------     
-- File => memory_management.adb
--
with Ada.Exceptions ;
with Ada.Text_Io ;
with System ;
with System.Storage_Elements ;
with System.Address_To_Access_Conversions ;
     
package body Memory_Management is
     
    use Ada ;
    use Text_Io ;
    use System ;
    use Storage_Elements ;
    use type Storage_Count ;
     
  Package_Name : constant String := "Memory_Management." ;
     
    -- Used to turn on/off the debug information
  Debug_On : Boolean := True ; -- False ;
     
  type Holder is record
         Next_Address : Address := System.Null_Address ;
  end record ;
     
  package Addr_To_Acc is new Address_To_Access_Conversions ( Holder ) ;
     
  -- Keep track of the size of memory block for reuse
  Free_Storage_Keeper : array ( Storage_Count range 1 .. 100 )
          of Address := ( others => Null_Address ) ;
     
  procedure Display_Info ( Message       : string ; 
                           With_New_Line : Boolean := True ) is
    begin
      if Debug_On then
        if With_New_Line then
          Put_Line ( Message ) ;
        else
          Put ( Message ) ;
        end if ;
      end if ;
    end Display_Info ;
     

  procedure Allocate ( Pool                     : in out User_Pool ;
                       Storage_Address          :    out Address   ;
                       Size_In_Storage_Elements : in Storage_Count ;
                       Alignment                : in Storage_Count ) is
          
      Procedure_Name : constant String := "Allocate" ;
      Temp_Address   : Address  := Null_Address ;
      Marker         : Storage_Count ;
    begin
     
      Marker := ( Size_In_Storage_Elements + Alignment - 1 )
              / Alignment ;
     
      if Free_Storage_Keeper ( Marker ) /= Null_Address then
        Storage_Address := Free_Storage_Keeper ( Marker ) ;
        Free_Storage_Keeper (Marker) :=
        Addr_To_Acc.To_Pointer 
                ( Free_Storage_Keeper ( Marker ) ).Next_Address ;
      else
        Temp_Address := Pool.Data (Pool.Addr_Index)'Address ;
              
        Pool.Addr_Index := Pool.Addr_Index 
                         + Alignment 
                         * ( ( Size_In_Storage_Elements 
                               + Alignment - 1 ) 
                         / Alignment ) ;
     
        -- make sure memory is available as requested
        if Pool.Addr_Index > Pool.Size then
          Exceptions.Raise_Exception ( Storage_Error'Identity,
                                       "Storage exhausted in " 
                                       & Package_Name 
                                       & Procedure_Name ) ;
        else
          Storage_Address := Temp_Address ;
        end if ;
      end if ;
     
      Display_Info  ( "Address allocated from pool: "
                      & Integer_Address'Image 
                          ( To_Integer ( Storage_Address ) ) ) ;
   
      Display_Info ( "storage elements allocated from pool: "
                     & Storage_Count'Image 
                          ( Size_In_Storage_Elements ) ) ;
     
      Display_Info ( "Alignment in allocation operation: "
                     & Storage_Count'Image ( Alignment ) ) ;
   
    exception
      when Error : others => -- Object too big or memory exhausted
        Display_Info ( Exceptions.Exception_Information ( Error ) ) ;
        raise ;
     
    end Allocate ;


  procedure Deallocate 
                     ( Pool                     : in out User_Pool ;
                       Storage_Address          : in     Address   ;
                       Size_In_Storage_Elements : in Storage_Count ;
                       Alignment                : in Storage_Count ) is
          
      Marker : Storage_Count ;
     
    begin
     
      Marker := ( Size_In_Storage_Elements + Alignment - 1) 
              / Alignment ;
      Addr_To_Acc.To_Pointer ( Storage_Address ).Next_Address :=
                                     Free_Storage_Keeper ( Marker ) ;
      Free_Storage_Keeper ( Marker ) := Storage_Address ;
     
      Display_Info  ( "Address returned to pool: " 
                      & Integer_Address'Image 
                          ( To_Integer ( Storage_Address ) ) ) ;
     
      Display_Info ( "storage elements returned to pool: "
                     & Storage_Count'Image 
                         ( Size_In_Storage_Elements ) ) ;
     
      Display_Info ( "Alignment used in deallocation: "
                     & Storage_Count'Image ( Alignment ) ) ;
     
  end Deallocate ;
     
  function Storage_Size ( Pool : in User_Pool ) 
             return Storage_Count is
    begin
      return Pool.Size ;
    end Storage_Size ;
     
end Memory_Management ;




^ permalink raw reply	[relevance 4%]

* Re: GNAT's Protected Objects
  2010-11-08 22:32  6%   ` Jeffrey Carter
  2010-11-09  1:50  0%     ` Anh Vo
@ 2010-11-09 10:18  0%     ` Egil Høvik
  1 sibling, 0 replies; 200+ results
From: Egil Høvik @ 2010-11-09 10:18 UTC (permalink / raw)


On Nov 8, 11:32 pm, Jeffrey Carter
<spam.jrcarter....@spam.not.acm.org> wrote:
>
>        Result : Matrix;

Result is shared between multiple tasks,
reduce references to a minimum by using a
temporary value:

>
>        task body Calc_One is
>           Row : Natural;
>           Col : Natural;

            Temp_Result : Float;

>        begin -- Calc_One
>           All_Results : loop
>              Control.Get (Row => Row, Col => Col);
>
>              exit All_Results when Row = 0;
>

               Temp_Result := 0.0;

>
>              Sum : for K in Index_Value loop

                 Temp_Result := Temp_Result + Left (Row, K) * Right(K,
Col);

>              end loop Sum;

               Result(Row, Col) := Temp_Result ;

>           end loop All_Results;
>        exception -- Calc_One
>        when E : others =>
>           Ada.Text_IO.Put_Line (Item => "Calc_One " &
> Ada.Exceptions.Exception_Information (E) );
>        end Calc_One;


This should give you a nice speedup :)


--
~egilhh



^ permalink raw reply	[relevance 0%]

* Re: GNAT's Protected Objects
  2010-11-08 22:32  6%   ` Jeffrey Carter
@ 2010-11-09  1:50  0%     ` Anh Vo
  2010-11-09 10:18  0%     ` Egil Høvik
  1 sibling, 0 replies; 200+ results
From: Anh Vo @ 2010-11-09  1:50 UTC (permalink / raw)


On Nov 8, 2:32 pm, Jeffrey Carter <spam.jrcarter....@spam.not.acm.org>
wrote:
> On 11/08/2010 02:38 PM, Anh Vo wrote:
>
>
>
> > How may tasks used, two or four, when slowness was observed when
> > compared to simple task? I will be supprised if the answer is two. It
> > is logically expected that two tasks should perform better than single
> > task. However, when it comes to four or greater task, the result may
> > not be true due to task switching cost.
>
> That's what I expected. However, any number of tasks > 1 took longer than a
> single task.
>
> > I would be glad to test it on my two core CPU mahine if the your
> > little program is posted.
>
> I have appended the code to this message. Watch for line wrapping.
>
> --
> Jeff Carter
> "Sir Robin the not-quite-so-brave-as-Sir-Lancelot,
> who had nearly fought the Dragon of Angnor,
> who nearly stood up to the vicious Chicken of Bristol,
> and who had personally wet himself at the
> Battle of Badon Hill."
> Monty Python & the Holy Grail
> 68
>
> with Ada.Exceptions;
> with Ada.Numerics.Float_Random;
> with Ada.Real_Time;
> with Ada.Text_IO;
>
> with System.Task_Info;
>
> procedure MP_Mult_PO is
>     Num_Processors : constant Positive := System.Task_Info.Number_Of_Processors;
>
>     subtype Index_Value is Integer range 1 .. 500;
>
>     type Matrix is array (Index_Value, Index_Value) of Float;
>
>     function Mult (Left : in Matrix; Right : in Matrix; Num_Tasks : in Positive)
> return Matrix;
>     -- Perform a concurrent multiplication of Left * Right using Num_Tasks tasks
>
>     function Mult (Left : in Matrix; Right : in Matrix; Num_Tasks : in Positive)
> return Matrix is
>        task type Calc_One;
>
>        protected Control is
>           procedure Get (Row : out Natural; Col : out Natural);
>           -- Returns the row and column of a result to calculate.
>           -- Returns zero for both when there are no more results to calculate.
>        private -- Control
>           Next_Row : Positive := 1;
>           Next_Col : Positive := 1;
>           Done     : Boolean  := False;
>        end Control;
>
>        Result : Matrix;
>
>        task body Calc_One is
>           Row : Natural;
>           Col : Natural;
>        begin -- Calc_One
>           All_Results : loop
>              Control.Get (Row => Row, Col => Col);
>
>              exit All_Results when Row = 0;
>
>              Result (Row, Col) := 0.0;
>
>              Sum : for K in Index_Value loop
>                 Result (Row, Col) := Result (Row, Col) + Left (Row, K) * Right
> (K, Col);
>              end loop Sum;
>           end loop All_Results;
>        exception -- Calc_One
>        when E : others =>
>           Ada.Text_IO.Put_Line (Item => "Calc_One " &
> Ada.Exceptions.Exception_Information (E) );
>        end Calc_One;
>
>        protected body Control is
>           procedure Get (Row : out Natural; Col : out Natural) is
>           begin -- Get
>              if Done then
>                 Row := 0;
>                 Col := 0;
>
>                 return;
>              end if;
>
>              Row := Next_Row;
>              Col := Next_Col;
>
>              if Next_Col < Index_Value'Last then
>                 Next_Col := Next_Col + 1;
>
>                 return;
>              end if;
>
>              Next_Col := 1;
>              Next_Row := Next_Row + 1;
>
>              Done := Next_Row > Index_Value'Last;
>           end Get;
>        end Control;
>     begin -- Mult
>        Create_Tasks : declare
>           type Task_List is array (1 .. Num_Tasks) of Calc_One;
>
>           Tasks : Task_List;
>        begin -- Create_Tasks
>           null; -- Wait for all tasks to complete
>        end Create_Tasks;
>
>        return Result;
>     exception -- Mult
>     when E : others =>
>        Ada.Text_IO.Put_Line (Item => "Mult " &
> Ada.Exceptions.Exception_Information (E) );
>
>        raise;
>     end Mult;
>
>     function Random return Float;
>
>     Gen : Ada.Numerics.Float_Random.Generator;
>
>     function Random return Float is
>     begin -- Random
>        return 200.0 * Ada.Numerics.Float_Random.Random (Gen) - 100.0; -- -100 ..
> 100.
>     end Random;
>
>     A : constant Matrix := Matrix'(others => (others => Random) );
>     B : constant Matrix := Matrix'(others => (others => Random) );
>
>     C : Matrix;
>
>     Elapsed   : Duration;
>     Prev      : Duration := Duration'Last;
>     Start     : Ada.Real_Time.Time;
>     Num_Tasks : Positive := 1;
>
>     use type Ada.Real_Time.Time;
> begin -- MP_Mult_PO
>     Ada.Text_IO.Put_Line (Item => "Num processors" & Integer'Image
> (Num_Processors) );
>
>     All_Calls : loop
>        Start := Ada.Real_Time.Clock;
>        C := Mult (A, B, Num_Tasks);
>        Elapsed := Ada.Real_Time.To_Duration (Ada.Real_Time.Clock - Start);
>        Ada.Text_IO.Put_Line (Item => Integer'Image (Num_Tasks) & ' ' &
> Duration'Image (Elapsed) );
>
>        exit All_Calls when Num_Tasks > 2 * Num_Processors and Elapsed > Prev;
>
>        Prev := Elapsed;
>        Num_Tasks := Num_Tasks + 1;
>     end loop All_Calls;
> exception -- MP_Mult_PO
> when E : others =>
>     Ada.Text_IO.Put_Line (Item => "MP_Mult_PO " &
> Ada.Exceptions.Exception_Information (E) );
> end MP_Mult_PO;

Below are the test results conducted on GNAT 2010 running on Windows
XP.

Num processors 2
 1  0.077000009
 2  0.055627741
 3  0.023719495
 4  0.018366580
 5  0.018512129

The output looks reasonable. The speed is improved up to 4 tasks. It
slows down with 5 tasks due to tasking switch. However, it is still
better than single task.

As Robert suggested, I would divide work among tasks by passing
paramter into each task. For example, in case of two tasks, one task
handles from rows 1 .. 250 while the other task handle from rows
251 .. 500. By the way, the protected singleton type Control is no
longer needed.

Anh Vo



^ permalink raw reply	[relevance 0%]

* Re: GNAT's Protected Objects
  @ 2010-11-08 22:32  6%   ` Jeffrey Carter
  2010-11-09  1:50  0%     ` Anh Vo
  2010-11-09 10:18  0%     ` Egil Høvik
  0 siblings, 2 replies; 200+ results
From: Jeffrey Carter @ 2010-11-08 22:32 UTC (permalink / raw)


On 11/08/2010 02:38 PM, Anh Vo wrote:
>
> How may tasks used, two or four, when slowness was observed when
> compared to simple task? I will be supprised if the answer is two. It
> is logically expected that two tasks should perform better than single
> task. However, when it comes to four or greater task, the result may
> not be true due to task switching cost.

That's what I expected. However, any number of tasks > 1 took longer than a 
single task.

> I would be glad to test it on my two core CPU mahine if the your
> little program is posted.

I have appended the code to this message. Watch for line wrapping.

-- 
Jeff Carter
"Sir Robin the not-quite-so-brave-as-Sir-Lancelot,
who had nearly fought the Dragon of Angnor,
who nearly stood up to the vicious Chicken of Bristol,
and who had personally wet himself at the
Battle of Badon Hill."
Monty Python & the Holy Grail
68

with Ada.Exceptions;
with Ada.Numerics.Float_Random;
with Ada.Real_Time;
with Ada.Text_IO;

with System.Task_Info;

procedure MP_Mult_PO is
    Num_Processors : constant Positive := System.Task_Info.Number_Of_Processors;

    subtype Index_Value is Integer range 1 .. 500;

    type Matrix is array (Index_Value, Index_Value) of Float;

    function Mult (Left : in Matrix; Right : in Matrix; Num_Tasks : in Positive) 
return Matrix;
    -- Perform a concurrent multiplication of Left * Right using Num_Tasks tasks

    function Mult (Left : in Matrix; Right : in Matrix; Num_Tasks : in Positive) 
return Matrix is
       task type Calc_One;

       protected Control is
          procedure Get (Row : out Natural; Col : out Natural);
          -- Returns the row and column of a result to calculate.
          -- Returns zero for both when there are no more results to calculate.
       private -- Control
          Next_Row : Positive := 1;
          Next_Col : Positive := 1;
          Done     : Boolean  := False;
       end Control;

       Result : Matrix;

       task body Calc_One is
          Row : Natural;
          Col : Natural;
       begin -- Calc_One
          All_Results : loop
             Control.Get (Row => Row, Col => Col);

             exit All_Results when Row = 0;

             Result (Row, Col) := 0.0;

             Sum : for K in Index_Value loop
                Result (Row, Col) := Result (Row, Col) + Left (Row, K) * Right 
(K, Col);
             end loop Sum;
          end loop All_Results;
       exception -- Calc_One
       when E : others =>
          Ada.Text_IO.Put_Line (Item => "Calc_One " & 
Ada.Exceptions.Exception_Information (E) );
       end Calc_One;

       protected body Control is
          procedure Get (Row : out Natural; Col : out Natural) is
          begin -- Get
             if Done then
                Row := 0;
                Col := 0;

                return;
             end if;

             Row := Next_Row;
             Col := Next_Col;

             if Next_Col < Index_Value'Last then
                Next_Col := Next_Col + 1;

                return;
             end if;

             Next_Col := 1;
             Next_Row := Next_Row + 1;

             Done := Next_Row > Index_Value'Last;
          end Get;
       end Control;
    begin -- Mult
       Create_Tasks : declare
          type Task_List is array (1 .. Num_Tasks) of Calc_One;

          Tasks : Task_List;
       begin -- Create_Tasks
          null; -- Wait for all tasks to complete
       end Create_Tasks;

       return Result;
    exception -- Mult
    when E : others =>
       Ada.Text_IO.Put_Line (Item => "Mult " & 
Ada.Exceptions.Exception_Information (E) );

       raise;
    end Mult;

    function Random return Float;

    Gen : Ada.Numerics.Float_Random.Generator;

    function Random return Float is
    begin -- Random
       return 200.0 * Ada.Numerics.Float_Random.Random (Gen) - 100.0; -- -100 .. 
100.
    end Random;

    A : constant Matrix := Matrix'(others => (others => Random) );
    B : constant Matrix := Matrix'(others => (others => Random) );

    C : Matrix;

    Elapsed   : Duration;
    Prev      : Duration := Duration'Last;
    Start     : Ada.Real_Time.Time;
    Num_Tasks : Positive := 1;

    use type Ada.Real_Time.Time;
begin -- MP_Mult_PO
    Ada.Text_IO.Put_Line (Item => "Num processors" & Integer'Image 
(Num_Processors) );

    All_Calls : loop
       Start := Ada.Real_Time.Clock;
       C := Mult (A, B, Num_Tasks);
       Elapsed := Ada.Real_Time.To_Duration (Ada.Real_Time.Clock - Start);
       Ada.Text_IO.Put_Line (Item => Integer'Image (Num_Tasks) & ' ' & 
Duration'Image (Elapsed) );

       exit All_Calls when Num_Tasks > 2 * Num_Processors and Elapsed > Prev;

       Prev := Elapsed;
       Num_Tasks := Num_Tasks + 1;
    end loop All_Calls;
exception -- MP_Mult_PO
when E : others =>
    Ada.Text_IO.Put_Line (Item => "MP_Mult_PO " & 
Ada.Exceptions.Exception_Information (E) );
end MP_Mult_PO;



^ permalink raw reply	[relevance 6%]

* Re: not catching exceptions
  2010-10-20  8:11  6% ` Ludovic Brenta
@ 2010-10-21  1:25  0%   ` mark
  0 siblings, 0 replies; 200+ results
From: mark @ 2010-10-21  1:25 UTC (permalink / raw)


Thanks for the reply.  I did not realize this is a gcc overall question. 
  I'll post there.  Before I do, I'll create a C++ program to make sure 
I get the same result.

I looked at the link you gave and tried rebuilding the cross compiler 
with -enable-sjlj-exceptions.  Unfortunately, on the target (uclibc) I get

# ./testit
./testit: can't resolve symbol '_Unwind_SjLj_Register' in lib './testit.

I have to leave the target environment alone.  My application is not the 
only one that runs in it (although it is the only Ada one).  So, I can't 
really modify uclibc.


On 10/20/2010 04:11 AM, Ludovic Brenta wrote:
> mark wrote on comp.lang.ada:
>> I'm targeting some Ada95 at three different systems.  One is a host
>> system running Linux, Intel based.  Exceptions are caught just fine.
>> Another is a bare board with a PowerPC running Linux.  Exceptions are
>> also trapped fine.  The third is a system running Linux but instead of
>> using glibc it uses uclibc.  Exceptions are not caught.  All I get is an
>> abort message (abort).  The configure information for this one is below-
>>
>>     $ ./powerpc-mpc8248-linux-uclibc-gcc -v
>>     Using built-in specs.
>>     Target: powerpc-mpc8248-linux-uclibc
>>     Configured with: ../../configure --prefix=/opt/atc/cpp_userchain
>>     /ppc8248-linux-toolchain --target=powerpc-mpc8248-linux-uclibc
>>     --with-cpu=603 --host=i686-pc-linux-gnu --build=i686-pc-linux-gnu
>>     --with-sysroot=/opt/atc/cpp_userchain/ppc8248-linux-toolchain/sysroot
>>     --enable-shared --enable-threads=gnat --disable-tls
>>     --disable__cxa_atexit --enable-languages=c,ada
>>      Thread model: gnat
>>      gcc version 4.1.2
>>
>> I've tried this with both --enable-threads (POSIX model) and
>> enable-threads=gnat.  I've tried with --enable__cxa_atexit and
>> --disable__cxa_atexit.  I can't seem to catch exceptions.
>>
>> A simple test program where I just raise and catch an exception gives
>> the same result...abort.  Outside of not being able to catch exceptions,
>> everything else works great (tasking, protected types, etc).
>>
>> Any thoughts on why exceptions are not being trapped on the  would be
>> appreciated.
>>
>> Thanks.
>
> I found this which may help:
>
> http://gcc.gnu.org/ml/gcc/2007-07/msg00290.html
>
> IIUC, you can enable exceptions on uClibc either by configuring the
> cross-compiler to use the setjump/longjump (SJLJ) mechanism or by
> patching uClibc to support zero-cost exceptions (ZCX).  It is possible
> that a newer version of uClibc is available that handles ZCX, possibly
> with some configuration.
>
> If you have more trouble, I suggest you ask on the GCC mailing list as
> your question is quite technical and not specific to Ada (exceptions
> are handled by the GCC back-end which is common to all languages).
>
> --
> Ludovic Brenta.




^ permalink raw reply	[relevance 0%]

* Re: not catching exceptions
  @ 2010-10-20  8:11  6% ` Ludovic Brenta
  2010-10-21  1:25  0%   ` mark
  0 siblings, 1 reply; 200+ results
From: Ludovic Brenta @ 2010-10-20  8:11 UTC (permalink / raw)


mark wrote on comp.lang.ada:
> I'm targeting some Ada95 at three different systems.  One is a host
> system running Linux, Intel based.  Exceptions are caught just fine.
> Another is a bare board with a PowerPC running Linux.  Exceptions are
> also trapped fine.  The third is a system running Linux but instead of
> using glibc it uses uclibc.  Exceptions are not caught.  All I get is an
> abort message (abort).  The configure information for this one is below-
>
>    $ ./powerpc-mpc8248-linux-uclibc-gcc -v
>    Using built-in specs.
>    Target: powerpc-mpc8248-linux-uclibc
>    Configured with: ../../configure --prefix=/opt/atc/cpp_userchain
>    /ppc8248-linux-toolchain --target=powerpc-mpc8248-linux-uclibc
>    --with-cpu=603 --host=i686-pc-linux-gnu --build=i686-pc-linux-gnu
>    --with-sysroot=/opt/atc/cpp_userchain/ppc8248-linux-toolchain/sysroot
>    --enable-shared --enable-threads=gnat --disable-tls
>    --disable__cxa_atexit --enable-languages=c,ada
>     Thread model: gnat
>     gcc version 4.1.2
>
> I've tried this with both --enable-threads (POSIX model) and
> enable-threads=gnat.  I've tried with --enable__cxa_atexit and
> --disable__cxa_atexit.  I can't seem to catch exceptions.
>
> A simple test program where I just raise and catch an exception gives
> the same result...abort.  Outside of not being able to catch exceptions,
> everything else works great (tasking, protected types, etc).
>
> Any thoughts on why exceptions are not being trapped on the  would be
> appreciated.
>
> Thanks.

I found this which may help:

http://gcc.gnu.org/ml/gcc/2007-07/msg00290.html

IIUC, you can enable exceptions on uClibc either by configuring the
cross-compiler to use the setjump/longjump (SJLJ) mechanism or by
patching uClibc to support zero-cost exceptions (ZCX).  It is possible
that a newer version of uClibc is available that handles ZCX, possibly
with some configuration.

If you have more trouble, I suggest you ask on the GCC mailing list as
your question is quite technical and not specific to Ada (exceptions
are handled by the GCC back-end which is common to all languages).

--
Ludovic Brenta.



^ permalink raw reply	[relevance 6%]

* Re: S-expression I/O in Ada
  2010-08-08 11:44  6%                   ` Dmitry A. Kazakov
@ 2010-08-08 11:48  0%                     ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2010-08-08 11:48 UTC (permalink / raw)


On Sun, 8 Aug 2010 13:44:48 +0200, Dmitry A. Kazakov wrote:

> On Sun, 08 Aug 2010 11:26:11 +0100, Simon Wright wrote:
> 
>> The only caution I'd add is that, at some point, when you're reading an
>> S-expression from an external file and you expect the next 4 bytes to
>> contain an integer in binary little-endian format,
> 
> S-expressions are bad, but not that bad. They have binary data encoded as
> hexadecimal strings.
> 
>> you're going to have
>> to trust _something_ to have got it right; if you wrote "*(struct foo
>> **)((char *)whatever + bar.offset)" in C you will have to write the
>> equivalent in Ada.
> 
> Luckily, Ada makes it difficult to write C equivalents. In Ada a
> "non-equivalent" could be:
> 
> with Ada.Streams;     use Ada.Streams;
> with Interfaces;      use Interfaces;
> with Ada.Exceptions;  use Ada.Exceptions;
> 
> function Get (Stream : access Root_Stream_Type'Class) return Unsigned_16 is

Unsigned_32

>    Result : Unsigned_16 := 0;

Unsigned_32

> begin
>    if '#' /= Character'Input (Stream) then
>       Raise_Exception (Syntax_Error'Identity, "Opening '#' is expected");
>    end if;
>    for Octet in 0..3 loop
>       Result :=
>          Result + Character'Pos (Character'Input (Stream)) * 2**Octet;

2**(Octet*8) of course

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de



^ permalink raw reply	[relevance 0%]

* Re: S-expression I/O in Ada
  @ 2010-08-08 11:44  6%                   ` Dmitry A. Kazakov
  2010-08-08 11:48  0%                     ` Dmitry A. Kazakov
  0 siblings, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2010-08-08 11:44 UTC (permalink / raw)


On Sun, 08 Aug 2010 11:26:11 +0100, Simon Wright wrote:

> The only caution I'd add is that, at some point, when you're reading an
> S-expression from an external file and you expect the next 4 bytes to
> contain an integer in binary little-endian format,

S-expressions are bad, but not that bad. They have binary data encoded as
hexadecimal strings.

> you're going to have
> to trust _something_ to have got it right; if you wrote "*(struct foo
> **)((char *)whatever + bar.offset)" in C you will have to write the
> equivalent in Ada.

Luckily, Ada makes it difficult to write C equivalents. In Ada a
"non-equivalent" could be:

with Ada.Streams;     use Ada.Streams;
with Interfaces;      use Interfaces;
with Ada.Exceptions;  use Ada.Exceptions;

function Get (Stream : access Root_Stream_Type'Class) return Unsigned_16 is
   Result : Unsigned_16 := 0;
begin
   if '#' /= Character'Input (Stream) then
      Raise_Exception (Syntax_Error'Identity, "Opening '#' is expected");
   end if;
   for Octet in 0..3 loop
      Result :=
         Result + Character'Pos (Character'Input (Stream)) * 2**Octet;
   end loop;
   if '#' /= Character'Input (Stream) then
      Raise_Exception (Syntax_Error'Identity, "Closing '#' is expected");
   end if;
   return Result;
end Get;

> Unless you were going to invent a sort of checked
> S-expression? (I don't get that impression!)

I don't think that were an invention. The program in C or Ada that does not
check the format of the input is broken to me.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de



^ permalink raw reply	[relevance 6%]

* Re: How to access this package written in C?
  @ 2010-04-21 17:39  6% ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2010-04-21 17:39 UTC (permalink / raw)


On Wed, 21 Apr 2010 09:43:02 -0700 (PDT), resander wrote:

> I am working on software that manipulates SQL databases via a GUI. It
> is written in C or C++ without classes and compiled on Linux. Would
> also want it to run on Windows eventually. This software has
> essentially one entry procedure:
> 
>   int guidb ( int appno , int recaddress );  // in C

This is awful even on C standards.

> which returns an outcome as an int, takes an int appno which specifies
> application and an address of a record in recaddress. The latter is
> used for passing the memory address of any recordtype variable and is
> cast to a byte address inside guidb.

[...]

> Desired use in Ada (same as above):
> 
> type PRODUCT is RECORD int prodcode; float price; char descr
> [50]...END RECORD;
> 
> procedure getproduct ( p : out PRODUCT ; result : out int ) is
> begin
>    result = guidb ( 0 , address_of(p) how ??? ) ;
> end
> 
> prod : PRODUCT;
> outcome : int ;

[...]

> How to do this in in Ada? If it cannot be done, can the interface
> above be changed to make it possible?

Make it a generic function:

   SQL_Error : exception;
   
   generic
      type Data_Type is private;
   function Generic_Get (No : Integer) return Data_Type;

The implementation of:
   
   with Ada.Exceptions;  use Ada.Exceptions;
   with Interfaces.C;    use Interfaces.C;

   function Generic_Get (No : Integer) return Data_Type is
      function Internal (No : int; Data : access Data_Type) return int;
      pragma Import (C, Internal, "guilib");
      Data   : aliased Data_Type;
      Result : int;
   begin
      Result := Internal (int (No), Data'Access);
      if Result /= 0 then
         Raise_Exception
         (SQL_Error'Identity, "Error code:" & int'Image (Result));
      else
         return Data;
      end if;
   end Generic_Get;

Declare a type you need, e.g. Product:

   type Product is record
      Code : int;
      Price  : float;
      Descr : char_array (1..50);
   end record;
   pragma Convention (C, Product); -- Note this pragma!

Instantiate the function:

   function Get is new Generic_Get (Product);

Use it as:

   X : Product := Get (0);

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de



^ permalink raw reply	[relevance 6%]

* Using gnat & ncurses
@ 2010-03-15 20:59  4% Warren
  0 siblings, 0 replies; 200+ results
From: Warren @ 2010-03-15 20:59 UTC (permalink / raw)


On the weekend I stumbled across a rather annoying
surprise. The culprit was the implementation of 
ncurses lib. I've only ever [recently] used it in
C and always assumed it was a C-only library. I
am aware that there is also a ncurses C++ interface 
as well, but I thought that was isolated. Well, maybe
not.

It turns out that if I use an Ada main program and
link with ncurses,  Ada exceptions fail (under
Cygwin) with an abort (Access violation IIRC). You
don't actually have to invoke any ncurses routines,
but simply reference something to cause it to link
in.

After some experimentation, I discovered that I could 
overcome the problem by making the main program
a C++ program and invoking the usual adainit/adafinal
routines. Annoying, but at least it is no longer
a "show stopper" that it initially appeared to be.

It just occurred to me that there was some sort 
of Ada binding in ncurses IIRC. Has anyone here 
had any experience with it?  Maybe that would
circumvent this main program annoyance among other
things.

Warren



^ permalink raw reply	[relevance 4%]

* Re: Addr2Line2Locations for GPS
  2010-01-19 10:23  5%     ` franck
@ 2010-01-19 13:49  7%       ` Gautier write-only
  0 siblings, 0 replies; 200+ results
From: Gautier write-only @ 2010-01-19 13:49 UTC (permalink / raw)


A variant (compatible with older GNAT's): instanciating the TB_Wrap
below and gnatmake that instanciation.
But I guess that Emmanuel wanted to say that future versions (which
are present ones in other time-spaces) spontaneously display a
symbolic trace-back instead of a bunch of addresses. But maybe I'm
just dreaming...
Gautier

------------------------------------------------------------------------------
--  File:            TB_Wrap.ads
--  Description:     Trace-back wrapper for GNAT 3.13p+ (spec.)
------------------------------------------------------------------------------

generic

  with procedure My_main_procedure;

procedure TB_Wrap;
------------------------------------------------------------------------------
--  File:            TB_Wrap.adb
--  Description:     Trace-back wrapper for GNAT 3.13p+ (body)
------------------------------------------------------------------------------

with GNAT.Traceback.Symbolic, Ada.Exceptions, Ada.Text_IO;
use Ada.Exceptions, Ada.Text_IO;

procedure TB_Wrap is
  --  pragma Compiler_options("-g");
  --  pragma Binder_options("-E");
begin
  My_main_procedure;
exception
  when E: others =>
    New_Line;
    Put_Line("--------------------[ Unhandled
exception ]-----------------");
    Put_Line(" > Name of exception . . . . .: " &
             Ada.Exceptions.Exception_Name(E) );
    Put_Line(" > Message for exception . . .: " &
             Ada.Exceptions.Exception_Message(E) );
    Put_Line(" > Trace-back of call stack: " );
    Put_Line( GNAT.Traceback.Symbolic.Symbolic_Traceback(E) );
end TB_Wrap;





^ permalink raw reply	[relevance 7%]

* Re: Addr2Line2Locations for GPS
  @ 2010-01-19 10:23  5%     ` franck
  2010-01-19 13:49  7%       ` Gautier write-only
  0 siblings, 1 reply; 200+ results
From: franck @ 2010-01-19 10:23 UTC (permalink / raw)


This may solve your problem :

use gnatmake -g  start -bargs -E to generate exe,
you will get :
--> start

Exception raised
Exception name: CONSTRAINT_ERROR
Message: start.adb:16 range check failed
0x804acdd in start.procedure_b at start.adb:16
0x804acbd in start.procedure_a at start.adb:21
0x804ab03 in start at start.adb:41
0x804a4d6 in main at b~start.adb:179
0xca1dea in ?? at ??:0
start :exception raised Exception name: CONSTRAINT_ERROR
Message: start.adb:16 range check failed
Call stack traceback locations:
0x804acdd 0x804acbd 0x804ab03 0x804a4d6 0xca1de

start.adb:
------


with Ada.Text_IO;
with Ada.Exceptions;
with GNAT.Exception_Traces; use GNAT.Exception_Traces;
with GNAT.Traceback.Symbolic;
procedure start is



procedure Procedure_B is
type Very_Small_Integer is range 0 .. 2;
My_Very_Small_Integer : Very_Small_Integer :=0;
begin

--warning: value not in range of type "Very_Small_Integer"
--warning: "Constraint_Error" will be raised at run time
My_Very_Small_Integer := 3;
end Procedure_B;

procedure Procedure_A is
begin
Procedure_B;
end Procedure_A;



begin
 -- reminder
 -- to compile this unit, use command :
 -- gnatmake -g  start -bargs -E

 -- -g => for gnatgcc debug information
 -- -E => for gnatbind Store tracebacks in exception occurrences when
the target supports it.
 -- This is the default with the zero cost exception mechanism. See
also the packages GNAT.Traceback and GNAT.Traceback.Symbolic

 -- GNAT init
 GNAT.Exception_Traces.Trace_On(GNAT.Exception_Traces.Every_Raise);
 GNAT.Exception_Traces.Set_Trace_Decorator
(GNAT.Traceback.Symbolic.Symbolic_Traceback'access);


Ada.Text_IO.Put_Line("--> start");
Procedure_A;
Ada.Text_IO.Put_Line("<-- start");

exception
when Error: others =>
   Ada.Text_IO.Put_Line ("start :exception raised " &
Ada.Exceptions.Exception_Information (Error));
end start;



^ permalink raw reply	[relevance 5%]

* Gnatbench 2.3.1 doing funny thing - any ideas?
@ 2009-08-05 10:40  6% John McCabe
  0 siblings, 0 replies; 200+ results
From: John McCabe @ 2009-08-05 10:40 UTC (permalink / raw)


I'm playing around with Eclipse Ganymede and Gnatbench (again).

I have a strange thing happening in the editor and haven't the
faintest idea where to look to see why this is happening so I hope
someone can point me in the right direction.

Basically I have a little program, just playing with it as a bit of a
reminder as I don't use Ada in anger these days...

1 ) with Ada.Text_Io;
2 ) with Ada.Integer_Text_Io;
3 ) with Ada.Exceptions;
4 )
5 ) procedure Mainproc is
6 )
7 )    protected type Mutex_Type is
8 )       entry Wait;
9 )       procedure Release;
10)    private
11)       Open : Boolean := True;
12)    end Mutex_Type;
13)
14)    protected body Mutex_Type is
15)       entry Wait when Open is
16)       begin
17)          Open := False;
18)       end Wait;
19)
20)       procedure Release is
21)       begin
22)          Open := True;
23)       end Release;
24)    end Mutex_Type;
25)
26)    Mutex_Po : Mutex_Type;
27)
28)    task type Synctask_Po (Id : Integer) is
29)       entry Startup;
30)    end Synctask_Po;
31)
32)    task body Synctask_Po is
33)       Usual_Delay : constant Duration := 1.0 + Duration (Id) /
10.0;
34)    begin
35)       accept Startup;
36)       while True
37)       loop
38)          Ada.Text_Io.Put_Line ("Task" & Integer'Image(Id) & ":
Waiting for Entry");
39)          Mutex_Po.Wait;
40)
41)          Ada.Text_Io.Put_Line ("Task" & Integer'Image(Id) & ": in
Critical Section");
42)          delay Usual_Delay;
43)
44)          Ada.Text_Io.Put_Line ("Task" & Integer'Image(Id) & ":
Releasing");
45)          Mutex_Po.Release;
46)          delay Usual_Delay;
47)       end loop;
48)    exception
49)       when X : others =>
50)          Ada.Text_Io.Put ("Exception occurred in synctask_po" &
51)                           Integer'Image(Id) &
52)                           ": " &
53)                           Ada.Exceptions.Exception_Name
(Ada.Exceptions.Exception_Identity (X)) &
54)                           " : " &
55)                           Ada.Exceptions.Exception_Message (X));
56)    end Synctask_Po;
57)
58)    type Synctask_Po_Access is access all Synctask_Po;
59)    Synctask_Po_Arr : array (1 .. 3) of Synctask_Po_Access;
60)
61) begin
62)    for I in 1 .. 3 loop
63)       Synctask_Po_Arr (I) := new Synctask_Po (I);
64)       Synctask_Po_Arr (I).Startup;
65)    end loop;
66) 
67) end Mainproc;

Now, on most lines, if I go to the start of the line and press the
enter key, it just gives me a blank line and moves the line I'm on
down one, putting the cursor at the start of the text. However, on
lines 38, 41 and 44 if I do that, it does the same sort of thing, but
prepends an extra "A" on to the line, so I get AAda.Text_Io...

In the Ada preferences, "Editor" section, I've got:

Save altered files before completion
Remove trailing spaces when saving
NOT Use smart space key
Minimum word lenght for expansion consideration = 3
Use smart tab key
Highlight matching brackets
Matching brackets highlight color [kind of grey]
NOT Insert header text into new Ada aource files
File containing.... both blank.

In the "Coding Style" I've got...
extended
3
2
1
3
0
automatic
lower_case
Mixed_Case
Format operators/delimiters
NOT use tabulations
NOT align colons
NOT align associations
NOT align declaration
Indent comments
NOT align comments

Any ideas anyone?

Thanks
John



^ permalink raw reply	[relevance 6%]

* Re: writing on terminal before an exception
  @ 2009-08-04  0:14  4%     ` Adam Beneschan
  0 siblings, 0 replies; 200+ results
From: Adam Beneschan @ 2009-08-04  0:14 UTC (permalink / raw)


On Aug 3, 3:29 pm, Yannick Duchêne Hibou57 <yannick_duch...@yahoo.fr>
wrote:
> On 3 août, 22:40, vlc <just.another.spam.acco...@googlemail.com>
> wrote:
>
> > Have you already considered something like
>
> > raise Sh3_NoData with "No SH3 data.";
>
> > I'm not absolutely sure, but I think this will only compile in Ada
> > 2005.
>
> It will, surely, as said the ARM 2005 :
>
> ARM 11.3 (2/2) says
>
> > raise_statement ::= raise;
> >       | raise exception_name [with string_expression]; raise [exception_name];
>
> But he will loose the default exception informations which are useful
> too (the string provided will replace the exception message which is
> defaulted to some exception informations).

It isn't lost.  If the exception is caught,
Ada.Exceptions.Exception_Information will still return information.
The RM says that Exception_Information returns "implementation-defined
information about the exception occurrence", and that
Exception_Message returns "implementation-defined information about
the exception occurrence" if RAISE is used without a
string_expression.  The RM doesn't say what the relationship between
those two strings is, but it's reasonable to assume that the string
returned by Exception_Information is at least as informative as the
default one returned by Exception_Message, if the two strings aren't
identical.

None of this matters if the exception isn't caught.  If the exception
is propagated out of the main program, the behavior is implementation-
dependent, and there's no guarantee that the message or any other
information will be displayed.  If the exception is propagated out of
a task body, the task will terminate and any message in the
RAISE...WITH statement will be lost.

                                           -- Adam




^ permalink raw reply	[relevance 4%]

* Re: unsigned type
  2009-07-02 19:49  5%   ` anon
@ 2009-07-03  1:42  0%     ` anon
  0 siblings, 0 replies; 200+ results
From: anon @ 2009-07-03  1:42 UTC (permalink / raw)


--
-- Just a side note.   Found while using a search engine.
--
with Ada.Text_IO ;
use  Ada.Text_IO ;

procedure Temp is

    C : constant String := ( 1..0 => 'A' ) ; 
    --
    --  So, what happens to the 'A' and why does the compiler allow 
    --  the constant 'A' when it result will be a null array.
    --
    --  If you use ( 1..0 => 'A' ) you must provide an unusable single
    --  Character, double quotes or emply quote are illegal.  Logic 
    --  suggest that the statement should be
    --  C : constant String := ( 1..0 => '' ) ;
    --
    D : constant String := "" ; 

begin

  Put_line ( "C => '" & C & "'  =  '" & C ( 1..0 ) & "'" ) ;
  New_Line ;

  Put_Line ( "is C equal to D => " & Boolean'Image ( C = D ) ) ;
  New_Line ;
 
end Temp ;


In <4b83m.98382$d36.15650@bgtnsc04-news.ops.worldnet.att.net>, anon@anon.org (anon) writes:
>--  Adam. 
>--    Now, can you please explain the results from this program.
>--
>--    It just does not make sense.  Because in the second pass though  
>--    Test.Put the bounds for String is ( 1..1 ) but if the procedure 
>--    uses a String ( 2 .. -2 ) which neither index is not within the 
>--    valid subscript range. And this is also echoed in the third pass.
>--
>--    Note: The RM uses ( 1 .. 0 ) but allows ( L .. R ) if L > R, for
>--           null arrays.  But I think the RM and ACATS suggest that the 
>--           Left side index needs to be a valid subscript of the array.
>--           Which make B ( 2 .. -2 ) illegal if the B String is bound
>--           by ( 1 .. 1 ).
>--
>with Ada.Integer_Text_IO ;
>with Ada.Text_IO ;
>with Ada.Exceptions ;
>
>procedure Test is
>
>  use Ada.Exceptions ;
>  use Ada.Integer_Text_IO ;
>  use Ada.Text_IO ;
>
>  C : String := "This is a test string" ;
>
>  --
>  -- Define a Put routine for String type.
>  --
>  procedure Put ( B : String ) is
>
>    begin
>      New_Line ;
>      Ada.Text_IO.Put ( "    B'( " ) ;
>      Put ( B'First ) ;
>      Ada.Text_IO.Put ( " .. " ) ;
>      Put ( B'Last ) ;
>      Ada.Text_IO.Put ( " ) => " ) ;
>      Ada.Text_IO.Put_Line ( ( B ( B'First .. B'Last ) ) ) ;
>
>      Ada.Text_IO.Put ( "    B'( 2 .. -2 ) => '" ) ;
>      Ada.Text_IO.Put ( ( B ( 2 .. -2 ) ) ) ;
>      Ada.Text_IO.Put ( ''' ) ;
>      New_Line ( 2 ) ;
>    end Put ;
>
>begin
>
>  Ada.Text_IO.Put_line ( "Normal String Print  --  Valid" ) ;
>  Ada.Text_IO.Put ( "C ( C'First .. C'Last ) => " ) ;
>  begin
>    Test.Put ( C ( C'First .. C'Last ) ) ;
>  exception
>    when E : Constraint_Error =>
>      Ada.Text_IO.Put_Line ( Exception_Name ( E ) & 
>                             " => " &
>                             Exception_Message ( E ) ) ;
>  end ;
>  New_Line ;
>
>  Ada.Text_IO.Put_line ( "Normal Sub String Print  --  Invalid???" ) ;
>  Ada.Text_IO.Put ( "C ( C'First .. C'First ) => " ) ;
>  begin
>    Test.Put ( C ( C'First .. C'First ) ) ;
>  exception
>    when E : Constraint_Error =>
>      Ada.Text_IO.Put_Line ( Exception_Name ( E ) & 
>                             " => " &
>                             Exception_Message ( E ) ) ;
>  end ;
>  New_Line ;
>
>
>  Ada.Text_IO.Put_line ( "Normal Sub String Print  --  Invalid???" ) ;
>  Ada.Text_IO.Put ( "C ( ( C'First + 4 ) .. ( C'Last - 4 ) ) => " ) ;
>  begin
>    Test.Put ( C ( ( C'First + 4 ) .. ( C'Last - 4 ) ) ) ;
>  exception
>    when E : Constraint_Error =>
>      Ada.Text_IO.Put_Line ( Exception_Name ( E ) & 
>                             " => " &
>                             Exception_Message ( E ) ) ;
>  end ;
>  New_Line ;
>
>end Test ;
>
>In <273dedb7-8d68-42d2-8602-aa44c79f3708@b9g2000yqm.googlegroups.com>, Adam Beneschan <adam@irvine.com> writes:
>>On Jun 30, 4:48=A0pm, a...@anon.org (anon) wrote:
>>> Read RM 3.5 =A0( 4 )
>>>
>>> Is "A ( 0 .. 0 )" an example of null range. =A0By the definition in RM 3.=
>>5
>>> ( 4 ), the Right side range (index) must be less than the Left side, so
>>> "A ( 0.. 0 )" is not a valid null range statement. So, this statement
>>> should generate a compiler or runtime error, because either range is not
>>> a subset of the range for Strings.
>>
>>OK, I think I've finally figured out why we're having this confusing
>>argument.  It goes way back to this post of yours:
>>
>>>> For Strings:
>>>>                          --  'A' is a zero length string, A'Last =3D 0, =
>>and
>>>>                          --  put_line  ( A ( A'First .. A'Last ) ) ;
>>>>                          --  does not raise an Constraint_Error even tho=
>>ugh in
>>>>                          --  this case it translate to:
>>>>                          --  put_line  ( A ( 0 .. 0 ) ) ;
>>>>  A : String :=3D ""        ;
>>
>>It does not translate to A (0..0); it translates to A (1..0).  If A is
>>declared as in your example above, A'First will be 1 and A'Last will
>>be 0.  Try it (try declaring A like that and outputting A'First and
>>A'Last).  It looks like everyone else missed this original error of
>>yours, which has apparently led to some confusion.
>>
>>In this case, A'First..A'Last, which is 1..0, is compatible with the
>>subtype because it's a null range, and null ranges are compatible with
>>the subtype even when the range bounds don't actually belong to the
>>subtype.  0..0 is not compatible with the subtype, but you cannot
>>declare a string with that index range unless you try to do it
>>explicitly:
>>
>>   A : String (0..0);
>>
>>and then you *will* get a Constraint_Error.
>>
>>So your later assertion that follows:
>>
>>>> Since you can have zero length string , the index is Natual instead of P=
>>ositive,
>>>> because zero is in Natural but is not define in Positive. Even though th=
>>e
>>>> Standard package define String index as a Positive type. (GNAT)
>>
>>is wrong.  The index range is Positive, but null ranges don't have to
>>meet that constraint.  They don't have to be Natural, either.  This is
>>legal and will not raise an exception at runtime:
>>
>>   B : String (-9 .. -10) :=3D "";
>>
>>Hope this clears everything up.
>>
>>                                  -- Adam
>>
>




^ permalink raw reply	[relevance 0%]

* Re: unsigned type
  @ 2009-07-02 19:49  5%   ` anon
  2009-07-03  1:42  0%     ` anon
  0 siblings, 1 reply; 200+ results
From: anon @ 2009-07-02 19:49 UTC (permalink / raw)


--  Adam. 
--    Now, can you please explain the results from this program.
--
--    It just does not make sense.  Because in the second pass though  
--    Test.Put the bounds for String is ( 1..1 ) but if the procedure 
--    uses a String ( 2 .. -2 ) which neither index is not within the 
--    valid subscript range. And this is also echoed in the third pass.
--
--    Note: The RM uses ( 1 .. 0 ) but allows ( L .. R ) if L > R, for
--           null arrays.  But I think the RM and ACATS suggest that the 
--           Left side index needs to be a valid subscript of the array.
--           Which make B ( 2 .. -2 ) illegal if the B String is bound
--           by ( 1 .. 1 ).
--
with Ada.Integer_Text_IO ;
with Ada.Text_IO ;
with Ada.Exceptions ;

procedure Test is

  use Ada.Exceptions ;
  use Ada.Integer_Text_IO ;
  use Ada.Text_IO ;

  C : String := "This is a test string" ;

  --
  -- Define a Put routine for String type.
  --
  procedure Put ( B : String ) is

    begin
      New_Line ;
      Ada.Text_IO.Put ( "    B'( " ) ;
      Put ( B'First ) ;
      Ada.Text_IO.Put ( " .. " ) ;
      Put ( B'Last ) ;
      Ada.Text_IO.Put ( " ) => " ) ;
      Ada.Text_IO.Put_Line ( ( B ( B'First .. B'Last ) ) ) ;

      Ada.Text_IO.Put ( "    B'( 2 .. -2 ) => '" ) ;
      Ada.Text_IO.Put ( ( B ( 2 .. -2 ) ) ) ;
      Ada.Text_IO.Put ( ''' ) ;
      New_Line ( 2 ) ;
    end Put ;

begin

  Ada.Text_IO.Put_line ( "Normal String Print  --  Valid" ) ;
  Ada.Text_IO.Put ( "C ( C'First .. C'Last ) => " ) ;
  begin
    Test.Put ( C ( C'First .. C'Last ) ) ;
  exception
    when E : Constraint_Error =>
      Ada.Text_IO.Put_Line ( Exception_Name ( E ) & 
                             " => " &
                             Exception_Message ( E ) ) ;
  end ;
  New_Line ;

  Ada.Text_IO.Put_line ( "Normal Sub String Print  --  Invalid???" ) ;
  Ada.Text_IO.Put ( "C ( C'First .. C'First ) => " ) ;
  begin
    Test.Put ( C ( C'First .. C'First ) ) ;
  exception
    when E : Constraint_Error =>
      Ada.Text_IO.Put_Line ( Exception_Name ( E ) & 
                             " => " &
                             Exception_Message ( E ) ) ;
  end ;
  New_Line ;


  Ada.Text_IO.Put_line ( "Normal Sub String Print  --  Invalid???" ) ;
  Ada.Text_IO.Put ( "C ( ( C'First + 4 ) .. ( C'Last - 4 ) ) => " ) ;
  begin
    Test.Put ( C ( ( C'First + 4 ) .. ( C'Last - 4 ) ) ) ;
  exception
    when E : Constraint_Error =>
      Ada.Text_IO.Put_Line ( Exception_Name ( E ) & 
                             " => " &
                             Exception_Message ( E ) ) ;
  end ;
  New_Line ;

end Test ;

In <273dedb7-8d68-42d2-8602-aa44c79f3708@b9g2000yqm.googlegroups.com>, Adam Beneschan <adam@irvine.com> writes:
>On Jun 30, 4:48=A0pm, a...@anon.org (anon) wrote:
>> Read RM 3.5 =A0( 4 )
>>
>> Is "A ( 0 .. 0 )" an example of null range. =A0By the definition in RM 3.=
>5
>> ( 4 ), the Right side range (index) must be less than the Left side, so
>> "A ( 0.. 0 )" is not a valid null range statement. So, this statement
>> should generate a compiler or runtime error, because either range is not
>> a subset of the range for Strings.
>
>OK, I think I've finally figured out why we're having this confusing
>argument.  It goes way back to this post of yours:
>
>>> For Strings:
>>>                          --  'A' is a zero length string, A'Last =3D 0, =
>and
>>>                          --  put_line  ( A ( A'First .. A'Last ) ) ;
>>>                          --  does not raise an Constraint_Error even tho=
>ugh in
>>>                          --  this case it translate to:
>>>                          --  put_line  ( A ( 0 .. 0 ) ) ;
>>>  A : String :=3D ""        ;
>
>It does not translate to A (0..0); it translates to A (1..0).  If A is
>declared as in your example above, A'First will be 1 and A'Last will
>be 0.  Try it (try declaring A like that and outputting A'First and
>A'Last).  It looks like everyone else missed this original error of
>yours, which has apparently led to some confusion.
>
>In this case, A'First..A'Last, which is 1..0, is compatible with the
>subtype because it's a null range, and null ranges are compatible with
>the subtype even when the range bounds don't actually belong to the
>subtype.  0..0 is not compatible with the subtype, but you cannot
>declare a string with that index range unless you try to do it
>explicitly:
>
>   A : String (0..0);
>
>and then you *will* get a Constraint_Error.
>
>So your later assertion that follows:
>
>>> Since you can have zero length string , the index is Natual instead of P=
>ositive,
>>> because zero is in Natural but is not define in Positive. Even though th=
>e
>>> Standard package define String index as a Positive type. (GNAT)
>
>is wrong.  The index range is Positive, but null ranges don't have to
>meet that constraint.  They don't have to be Natural, either.  This is
>legal and will not raise an exception at runtime:
>
>   B : String (-9 .. -10) :=3D "";
>
>Hope this clears everything up.
>
>                                  -- Adam
>




^ permalink raw reply	[relevance 5%]

* Re: Not visible
  2009-06-24  9:37  6% Not visible Pietro Tornaindietro
@ 2009-06-24  9:56  0% ` Georg Bauhaus
  0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2009-06-24  9:56 UTC (permalink / raw)


Pietro Tornaindietro schrieb:
> hi, i'm a newbie.
> 
> i'm using APQ.
> 
> ith APQ.PostgreSQL, APQ.PostgreSQL.Client;
> with Ada.exceptions;
> with Text_IO;
> use Text_IO;
> use Ada.exceptions;
> with APQ.PostgreSQL, APQ.PostgreSQL.Client;
> 
> procedure aa33 is
>    use APQ.PostgreSQL, APQ.PostgreSQL.Client;
> 
>    C : Connection_Type;
> begin
> 	Connect(C);
> 
> exception
>    when Not_Connected =>
> 
> 
> and when i compile this code, gnat tells me " "Not_Connected" is not
> visible".
> 
> what's the problem?


Where is Not_Connected declared?
In case it is declared in APQ, the declarations of APQ
aren't visible directly.  "use P1.P2" makes the declarations
of P2 directly visible, but not those of P1.
In case there are two declarations of exception Not_Connected,
one in APQ.PostgreSQL and one in APQ.PostgreSQL.Client (though
I'd doubt it), then making both names directly visible by
"use"ing both packages leads to a conflict.



^ permalink raw reply	[relevance 0%]

* Not visible
@ 2009-06-24  9:37  6% Pietro Tornaindietro
  2009-06-24  9:56  0% ` Georg Bauhaus
  0 siblings, 1 reply; 200+ results
From: Pietro Tornaindietro @ 2009-06-24  9:37 UTC (permalink / raw)


hi, i'm a newbie.

i'm using APQ.

ith APQ.PostgreSQL, APQ.PostgreSQL.Client;
with Ada.exceptions;
with Text_IO;
use Text_IO;
use Ada.exceptions;
with APQ.PostgreSQL, APQ.PostgreSQL.Client;

procedure aa33 is
   use APQ.PostgreSQL, APQ.PostgreSQL.Client;

   C : Connection_Type;
begin
	Connect(C);

exception
   when Not_Connected =>


and when i compile this code, gnat tells me " "Not_Connected" is not
visible".

what's the problem?
i searched in google for this problem but no answers.

thanks in advance

-- 

questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news segnala gli abusi ad abuse@newsland.it





^ permalink raw reply	[relevance 6%]

* Re: Issue with GNAT GPL 2009 and GtkAda
  2009-06-23 21:52  3% Issue with GNAT GPL 2009 and GtkAda Damien Carbonne
@ 2009-06-24  7:40  4% ` Dmitry A. Kazakov
  0 siblings, 0 replies; 200+ results
From: Dmitry A. Kazakov @ 2009-06-24  7:40 UTC (permalink / raw)


On Tue, 23 Jun 2009 23:52:59 +0200, Damien Carbonne wrote:

> When compiling a program I had written to GNAT GPL 2009 on Linux and 
> Windows, I met a problem with the usage of Gtk.Tree_Model.Foreach.
> 
> I wrote a relatively small program (unfortunately, still quite long) 
> that reproduces the problem (attached in the end).
> 
> I wonder if this is a bug in
>     1) my program,
>     2) GtkAda or
>     3) GNAT GPL 2009.
> What surprises me is that it was quite hard to reproduce this problem.
> Most other examples I wrote with Foreach worked very well.
> I don't know how GNAT handles accessibility rules.
> I wonder if the problem is not related to the usage of Interfaces ?
> I did not try yet to change the program so that it can work, but other 
> examples I wrote were quite similar, except that they did not use 
> interfaces. I'll check, but do you have any idea on this issue ?

Well, it is difficult to say, I never used foreach. I do Gtk_Tree_Iter
instead. I looked briefly at the implementation of Foreach in GtkAda and
found nothing offending.

Interface should not be a problem. Run-time accessibility checks is always
a *huge* problem. If in doubt use Unchecked_Access everywhere. I know it is
disgusting, but so is the propagation of a Constraint_Error at run-time.

Other possible issues:

1. Types extending GtkAda types must be library-level

2. Text_IO shall not be used (may cause exception propagation at least on
some platforms, with a subsequent crash. Ada exceptions propagated through
Gtk almost certainly crash the program. You cannot catch them)

3. In your code there is no "unref" the model after Set_Model. Tree model
is not a widget, it must be explicitly unreferenced.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de



^ permalink raw reply	[relevance 4%]

* Issue with GNAT GPL 2009 and GtkAda
@ 2009-06-23 21:52  3% Damien Carbonne
  2009-06-24  7:40  4% ` Dmitry A. Kazakov
  0 siblings, 1 reply; 200+ results
From: Damien Carbonne @ 2009-06-23 21:52 UTC (permalink / raw)
  To: gtkada

Hi,

When compiling a program I had written to GNAT GPL 2009 on Linux and 
Windows, I met a problem with the usage of Gtk.Tree_Model.Foreach.

I wrote a relatively small program (unfortunately, still quite long) 
that reproduces the problem (attached in the end).

I wonder if this is a bug in
    1) my program,
    2) GtkAda or
    3) GNAT GPL 2009.
What surprises me is that it was quite hard to reproduce this problem.
Most other examples I wrote with Foreach worked very well.
I don't know how GNAT handles accessibility rules.
I wonder if the problem is not related to the usage of Interfaces ?
I did not try yet to change the program so that it can work, but other 
examples I wrote were quite similar, except that they did not use 
interfaces. I'll check, but do you have any idea on this issue ?

Thanks for help !

Regards,

Damien Carbonne


--------------------------------------------------------------------------
with Bug;
procedure Main is
begin
    Bug.Main;
end Main;
-- Tested with GNAT GPL 2009 on Linux

-- When this program is run, these messages are printed:
--
-- View.Window.Gtk_New
-- View.Window.Initialize
-- View.Store.Gtk_New
-- View.Store.Initialize
-- Model.Attach_Listener
--
-- Then, when one clicks in "Click here to raise exception" button,
-- those one are printed:
--
-- View.Window.On_Reset_Usage_Clicked
-- Model.Do_Something_And_Notify_Listener
-- View.Store.Process
-- View.Store.Visit_Nodes
-- View.Store.Run Foreach ...
-- Exception raised in View.Store.Visit_Nodes
-- Exception name: PROGRAM_ERROR
-- Message: gtk-tree_model.adb:838 accessibility check failed
--
--
-- raised PROGRAM_ERROR : gtk-tree_model.adb:838 accessibility check failed

--------------------------------------------------------------------------
with Gtk.Tree_Store;      use Gtk.Tree_Store;
with Gtk.Window;          use Gtk.Window;
with Gtk.Box;             use Gtk.Box;
with Gtk.Button;          use Gtk.Button;
with Gtk.Tree_View;       use Gtk.Tree_View;

package Bug is

 
-----------------------------------------------------------------------------
    -- This package is a simplified model representation
    -- It holds an access to 1 listener and calls the attached listener
    -- when Do_Something_And_Notify_Listeneris called
    package Model is

       procedure Do_Something_And_Notify_Listener;

       type Model_Listener is limited interface;
       type Model_Listener_Ref is access all Model_Listener'Class;
       procedure Process (Listener : in out Model_Listener) is abstract;

       procedure Attach_Listener (Listener : Model_Listener_Ref);

    end Model;
 
-----------------------------------------------------------------------------
    -- This package is a simplified view representation
    package View is
 
--------------------------------------------------------------------------
       -- This package is supposed to contain a tree representation of
       -- the above model.
       -- The store is also a listener of the above model.
       -- When process is called, Foreach is called, and the program
       -- terminates with an exception.
       package Store is
          Index_Name : constant := 0;
          -- Index used to store a string (name)

          type View_Store_Record is new Gtk_Tree_Store_Record and
            Model.Model_Listener with private;

          type View_Store is access all View_Store_Record'Class;

          procedure Gtk_New (Store : out View_Store);
          procedure Initialize (Store : access View_Store_Record'Class);

       private
          type View_Store_Record is new Gtk_Tree_Store_Record and
            Model.Model_Listener with null record;
          overriding
          procedure Process (Store : in out View_Store_Record);
       end Store;
 
--------------------------------------------------------------------------
       -- This package is supposed to provide the graphical
       -- representation of the above tree store.
       -- When the user click on the button, a call to
       -- Model.Do_Something_And_Notify_Listener is done.
       -- The attached model listener is then called.
       package Window is
          type View_Window_Record is new Gtk_Window_Record with record
             Vbox      : Gtk_Vbox;
             Button    : Gtk_Button;
             Tree_View : Gtk_Tree_View;
          end record;

          type View_Window_Ref is access all View_Window_Record'Class;

          procedure Gtk_New (Widget : out View_Window_Ref);
          procedure Initialize
            (Widget : access View_Window_Record'Class);
       end Window;
 
--------------------------------------------------------------------------
    end View;
 
-----------------------------------------------------------------------------
    procedure Main;
end Bug;

with System;
with Ada.Text_IO;
with Ada.Exceptions;
with Gtk.Tree_Model;         use Gtk.Tree_Model;
with Glib;
with Gtk.Enums;              use Gtk.Enums;
with Gtk.Tree_View_Column;   use Gtk.Tree_View_Column;
with Gtk.Cell_Renderer_Text; use Gtk.Cell_Renderer_Text;
with Gtk.Widget;             use Gtk.Widget;
with Gtk.Handlers;
with Gtk.Main;

package body Bug is

    -----------
    -- Model --
    -----------

    package body Model is

       G_Listener : Model_Listener_Ref := null;

       --------------------------------------
       -- Do_Something_And_Notify_Listener --
       --------------------------------------

       procedure Do_Something_And_Notify_Listener is
       begin
          Ada.Text_IO.Put_Line
            ("Model.Do_Something_And_Notify_Listener");
          if G_Listener /= null then
             G_Listener.Process;
          end if;
       end Do_Something_And_Notify_Listener;

       ---------------------
       -- Attach_Listener --
       ---------------------

       procedure Attach_Listener (Listener : Model_Listener_Ref) is
       begin
          Ada.Text_IO.Put_Line ("Model.Attach_Listener");
          G_Listener := Listener;
       end Attach_Listener;

    end Model;

    ----------
    -- View --
    ----------

    package body View is

       -----------
       -- Store --
       -----------

       package body Store is

          ----------------
          -- Visit_Node --
          ----------------

          function Visit_Node
            (Model     : access Gtk_Tree_Model_Record'Class;
             Path      : Gtk_Tree_Path;
             Iter      : Gtk_Tree_Iter;
             User_Data : System.Address)
             return      Boolean
          is
             pragma Unreferenced (Model, Iter, User_Data);
          begin
             Ada.Text_IO.Put_Line
               ("View.Store.Visit_Node: [" & To_String (Path) & "]");
             return False;
          end Visit_Node;

          -----------------
          -- Visit_Nodes --
          -----------------

          procedure Visit_Nodes
            (Store : access View_Store_Record'Class)
          is
          begin
             Ada.Text_IO.Put_Line ("View.Store.Visit_Nodes");
             Ada.Text_IO.Put_Line ("View.Store.Run Foreach ...");
             Foreach (Store, Visit_Node'Access, System.Null_Address);
             Ada.Text_IO.Put_Line ("View.Store.Foreach Done");
          exception
             when E : others =>
                Ada.Text_IO.Put_Line
                  ("Exception raised in View.Store.Visit_Nodes");
                Ada.Text_IO.Put_Line
                  (Ada.Exceptions.Exception_Information (E));
                raise;
          end Visit_Nodes;

          -------------
          -- Gtk_New --
          -------------

          procedure Gtk_New (Store : out View_Store) is
          begin
             Ada.Text_IO.Put_Line ("View.Store.Gtk_New");
             Store := new View_Store_Record;
             Initialize (Store);
          end Gtk_New;

          ----------------
          -- Initialize --
          ----------------

          procedure Initialize
            (Store : access View_Store_Record'Class)
          is
             Iter : Gtk_Tree_Iter;
          begin
             Ada.Text_IO.Put_Line ("View.Store.Initialize");
             Gtk.Tree_Store.Initialize
               (Store,
                Glib.GType_Array'(Index_Name => Glib.GType_String));

             -- Create dummy nodes in the store
             Store.Insert (Iter, Null_Iter, 0);
             Store.Set (Iter, Index_Name, "Root");

             -- Attach itself as a listener
             Model.Attach_Listener (Model.Model_Listener_Ref (Store));
          end Initialize;

          -------------
          -- Process --
          -------------

          procedure Process (Store : in out View_Store_Record) is
          begin
             Ada.Text_IO.Put_Line ("View.Store.Process");
             Store.Visit_Nodes;
          end Process;

       end Store;

       ------------
       -- Window --
       ------------

       package body Window is
          package Button_Cb is new
             Gtk.Handlers.Callback (Gtk_Button_Record);
          G_View_Store : Store.View_Store := null;

          ----------------------------
          -- On_Reset_Usage_Clicked --
          ----------------------------

          procedure On_Reset_Usage_Clicked
            (Widget : access Gtk_Button_Record'Class)
          is
             pragma Unreferenced (Widget);
          begin
             Ada.Text_IO.Put_Line ("View.Window.On_Reset_Usage_Clicked");
             Model.Do_Something_And_Notify_Listener;
          end On_Reset_Usage_Clicked;

          -------------
          -- Gtk_New --
          -------------

          procedure Gtk_New (Widget : out View_Window_Ref) is
          begin
             Ada.Text_IO.Put_Line ("View.Window.Gtk_New");
             Widget := new View_Window_Record;
             Initialize (Widget);
          end Gtk_New;

          ----------------
          -- Initialize --
          ----------------

          procedure Initialize
            (Widget : access View_Window_Record'Class)
          is
             Column        : Gtk_Tree_View_Column;
             Text_Renderer : Gtk_Cell_Renderer_Text;
             Foo           : Glib.Gint;
             pragma Unreferenced (Foo);
             use Store;
          begin
             Ada.Text_IO.Put_Line ("View.Window.Initialize");

             -- Window
             Gtk.Window.Initialize (Widget, Window_Toplevel);
             Set_Title (Widget, "Bug with Foreach");
             Set_Default_Size (Widget, 300, 200);

             -- VBox
             Gtk_New_Vbox (Widget.Vbox, False, 0);
             Add (Widget, Widget.Vbox);

             -- Button
             Gtk_New (Widget.Button, "Click here to raise exception");
             Pack_Start
               (Widget.Vbox,
                Widget.Button,
                Expand  => False,
                Fill    => False,
                Padding => 0);

             -- Tree view
             Gtk_New (Widget.Tree_View);
             Set_Headers_Visible (Widget.Tree_View, True);
             Pack_Start
               (Widget.Vbox,
                Widget.Tree_View,
                Expand  => True,
                Fill    => True,
                Padding => 0);

             -- Renderers
             Gtk_New (Column);
             Set_Title (Column, "Title");
             Foo := Append_Column (Widget.Tree_View, Column);

             Gtk_New (Text_Renderer);
             Pack_Start (Column, Text_Renderer, False);
             Add_Attribute (Column, Text_Renderer, "text",
                            Store.Index_Name);

             -- Callbacks
             Button_Cb.Connect
               (Widget.Button,
                "clicked",
                Button_Cb.To_Marshaller (On_Reset_Usage_Clicked'Access));

             -- Create once the same log store shared by all windows
             if G_View_Store = null then
                Gtk_New (G_View_Store);
             end if;

             Set_Model (Widget.Tree_View, G_View_Store.all'Access);
          end Initialize;

       end Window;

    end View;

    ----------
    -- Main --
    ----------

    procedure Main is
       G_Window : View.Window.View_Window_Ref := null;
    begin
       Gtk.Main.Set_Locale;
       Gtk.Main.Init;
       View.Window.Gtk_New (G_Window);
       G_Window.Show_All;
       Gtk.Main.Main;
    end Main;

end Bug;



^ permalink raw reply	[relevance 3%]

* Timing Example was Re: Interrupt handler and Ada.Real_Time.Timing_Events
  @ 2009-05-16 11:05  5% ` anon
  0 siblings, 0 replies; 200+ results
From: anon @ 2009-05-16 11:05 UTC (permalink / raw)


This is a Timeing example that uses "Ada.Real_Time.Timing_Events" package.

Now, adding an interrupt handler to this design you should wrap the interrupt 
handler within a Task routine bacuse "Ada.Real_Time.Timing_Events" uses 
tasking for its underlying algorithm, then call the Timers Shutdown routine 
once the interrupt has occurred.

--
-- generic_timers.ads
--
with Ada.Real_Time.Timing_Events ;

generic
  Multi_Events : Boolean := True ;
  Timer_Name   : String := "Generic_Timers" ;
  Interval     : in Ada.Real_Time.Time_Span ;
  with procedure Action is <> ;

package Generic_Timers is

  Timer_Error : exception ;

  procedure Activate ;
  procedure Shutdown ;

private

  The_Event : Ada.Real_Time.Timing_Events.Timing_Event ;

end Generic_Timers ;

--
-- generic_timers.adb
--
with Ada.Real_Time ;
use  Ada.Real_Time ;

package body Generic_Timers is


  protected Events is
    procedure Handler ( Event: in out Timing_Events.Timing_Event ) ;
  end Events ;

  protected body Events is
    procedure Handler ( Event: in out Timing_Events.Timing_Event ) is
      begin
        Action ;
        if Multi_Events then
          Activate ;  -- periodic timer continues
        end if ;
      end Handler ;
  end Events ;

  procedure Activate is
    use type Timing_Events.Timing_Event_Handler ;
  begin
    if Timing_Events.Current_Handler ( The_Event ) = null then
      Timing_Events.Set_Handler ( The_Event,
                                  Interval,
                                  Events.Handler'Access ) ;
    else
      raise Timer_Error with "Activation " & Timer_Name ;
    end if ;
   end Activate ;

  procedure Shutdown is
      Success : Boolean := False ;
      use type Timing_Events.Timing_Event_Handler ;
    begin
      if Timing_Events.Current_Handler ( The_Event ) /= null then
         Timing_Events.Cancel_Handler ( The_Event, Success ) ;
         if not Success then
            raise Timer_Error with "Shutdown: " & Timer_Name ;
         end if ;
      end if ;
    end Shutdown ;

end Generic_Timers ;

--
-- timers.ads
--
package Timers is

   procedure Activate ;
   procedure Shutdown ;

end Timers ;

--
-- Timers.adb
--
with Ada.Real_Time ;
with Ada.Text_IO ;

with Generic_Timers ;

package body Timers is

   use Ada ;
   use Real_Time ;
   use Text_IO ;

   ------------------------------------
   --  Define Periodic Event Timers  --
   ------------------------------------
   Periodic_Interval : constant Time_Span := Milliseconds ( 2000 ) ;
   Periodic_Timer_ID : constant String := "Periodic Timer" ;

   procedure Periodic_Action is
   begin
      Put_Line ( "Timeout: Periodic Timer" ) ;
   end Periodic_Action ;

   Package Periodic_Timer is new Generic_Timers ( True,
                                                  Periodic_Timer_ID, 
                                                  Periodic_Interval, 
                                                  Periodic_Action ) ;

   ----------------------------------
   --  Define Single Event Timers  --
   ----------------------------------
   Single_Interval : constant Time_Span := Milliseconds ( 1000 ) ;
   Single_Timer_ID : constant String := "Single Timer" ;

   procedure Single_Action is
   begin
      Put_Line ( "Timeout: Single Timer " ) ;
   end Single_Action ;

   Package Single_Timer is new Generic_Timers ( False,
                                                Single_Timer_ID,
                                                Single_Interval,
                                                Single_Action ) ;

  ----------------------------
  --  Controlling Routines  --
  ----------------------------

  procedure Activate is
   begin
      Put_Line ( "Timers: Activate" ) ;

      Periodic_Timer.Activate ;

      for Index in 0 .. 3 loop
        Single_Timer.Activate ;
        delay 7.0 ;
      end loop;
    end Activate ;

  procedure Shutdown is
    begin
      Put_Line ( "Timers: Shutdown" ) ;
      Periodic_Timer.Shutdown ;
      Single_Timer.Shutdown ;
    end Shutdown;

end Timers ;

--
-- testing.adb
--
with Ada.Exceptions ;
with Ada.Text_IO ;

with Timers ;

procedure Testing is

   use Ada ;
   use Text_IO ;

begin

   Put_Line ( "Testing : Begin" ) ;

   Timers.Activate ;
   delay 5.0 ;
   Timers.Shutdown ;
   
   Put_Line ( "Testing : End" ) ;
exception
   when Error : others =>
       Put_Line ( "Testing fails for because of ==> "
                  & Exceptions.Exception_Information ( Error ) ) ;
end Testing ;



In <guk532$u44$1@news.motzarella.org>, Reto Buerki <reet@codelabs.ch> writes:
>Hi,
>
>I hit a rather strange issue today mixing signal/interrupt handling with
>Ada.Real_Time.Timing_Events. We have a real life application where we
>use timing events but we also need a signal handler to catch signals
>from the environment (SIGTERM etc.).
>
>I wrote a small reproducer to illustrate the problem. The following
>protected object is used as an interrupt handler, which can be attached
>to a specific interrupt/signal:
>
>with Ada.Interrupts;
>
>package Handlers is
>
>   protected type Signal_Handler (Signal : Ada.Interrupts.Interrupt_ID)
>   is
>      pragma Interrupt_Priority;
>
>      entry Wait;
>   private
>      procedure Handle_Signal;
>      pragma Attach_Handler (Handle_Signal, Signal);
>
>      Occured : Boolean := False;
>   end Signal_Handler;
>
>end Handlers;
>
>package body Handlers is
>
>   protected body Signal_Handler is
>      procedure Handle_Signal is
>      begin
>         Occured := True;
>      end Handle_Signal;
>
>      entry Wait when Occured is
>      begin
>         if Wait'Count = 0 then
>            Occured := False;
>         end if;
>      end Wait;
>   end Signal_Handler;
>
>end Handlers;
>
>The handler is used like this:
>
>with Ada.Text_IO;
>with Ada.Interrupts.Names;
>
>--  Uncommenting the next line breaks interrupt handler
>--  with Ada.Real_Time.Timing_Events;
>
>with Handlers;
>
>procedure Interrupt_Problem is
>   use Ada.Interrupts;
>
>   Handler : Handlers.Signal_Handler (Signal => Names.SIGTERM);
>begin
>
>   if Is_Attached (Interrupt => Names.SIGTERM) then
>      Ada.Text_IO.Put_Line ("Attached handler to SIGTERM");
>   else
>      Ada.Text_IO.Put_Line ("Could not attach to SIGTERM!");
>      return;
>   end if;
>
>   Handler.Wait;
>   Ada.Text_IO.Put_Line ("Interrupt received ...");
>
>end Interrupt_Problem;
>
>As expected, when sending SIGTERM to the running 'Interrupt_Problem'
>process "Interrupt received ..." is displayed. So far so good.
>
>As commented in the source code, as soon as the
>Ada.Real_Time.Timing_Events package is with'ed, this mechanism breaks.
>
>The signal handler is not invoked any more when I send a SIGTERM signal
>to a running 'Interrupt_Problem' process, it just terminates without
>triggering the Handler.Wait.
>
>What could be the cause for this behavior? Is there a problem with this
>code?
>
>Thanks in advance!
>- reto




^ permalink raw reply	[relevance 5%]

* Re: Newbie question -- dereferencing access
  @ 2009-03-13 17:33  6%               ` Martin
  0 siblings, 0 replies; 200+ results
From: Martin @ 2009-03-13 17:33 UTC (permalink / raw)


On Mar 13, 4:31 pm, Tim Rowe <spamt...@tgrowe.plus.net> wrote:
> Alex R. Mosteo wrote:
> > While these are certainly important skills, one thing you should notice when
> > transitioning to Ada is a decreased need for access types thanks to
> > unconstrained/indefinite types. I'd think that would mean that you're in the
> > right track.
>
> But I can't put an unconstrained type into a record. I realise that I
> can make the record discriminated and constrain the type on the
> discriminant, trying to write a class that gives strtok-like
> functionality -- the excercise I have set myself at the moment -- means
> that I discover the sizes of relevant strings rather late in the game.
>
> > Anyway, if you have a sound knowledge of memory management in C/C++, it's
> > pretty much the same. Don't forget to deallocate, wrap it all in a
> > controlled type.
>
> What I'm feeling the lack of is destructors for classes (sorry, for
> tagged records). I suspect I'll find what I need when I learn about
> finalizers, but whereas in C++ I learned about delete at the same time
> as I learned about new, and I learned about destructors at the same time
> as I learned about constructors, it seems strange in Ada to find access
> allocation addressed in the mainstream and access deallocation relegated
> to an advanced topic (and destructors nowhere in my sight). And yet it's
> C/C++ that has the reputation for memory leaks!

This might help:

It's my implementation of the "Ada1Z" package
Ada.Containers.Indefinite_Holders (AI0069):

File: a-coinho.ads
--  The language-defined generic package Containers.Indefinite_Holders
--  provides private type Holder and a set of operations for that
type. A
--  holder container holds a single element of an indefinite type.
--
--  A holder containers allows the declaration of an object that can
be used
--  like an uninitialized variable or component of an indefinite type.
--
--  A holder container may be *empty*. An empty holder does not
contain an
--  element.

with Ada.Finalization;
with Ada.Streams;

generic
   type Element_Type (<>) is private;
   with function "=" (Left, Right : Element_Type) return Boolean is
<>;
   --  The actual function for the generic formal function "=" on
Element_Type
   --  values is expected to define a reflexive and symmetric
relationship and
   --  return the same result value each time it is called with a
particular
   --  pair of values. If it behaves in some other manner, the
function "=" on
   --  holder values returns an unspecified value. The exact arguments
and
   --  number of calls of this generic formal function by the function
"=" on
   --  holder values are unspecified.
   --
   --     AARM Ramification: If the actual function for "=" is not
symmetric
   --     and consistent, the result returned by any of the functions
defined
   --     to use "=" cannot be predicted. The implementation is not
required
   --     to protect against "=" raising an exception, or returning
random
   --     results, or any other "bad" behavior. And it can call "=" in
   --     whatever manner makes sense. But note that only the results
of the
   --     function "=" is unspecified; other subprograms are not
allowed to
   --     break if "=" is bad.
package Ada.Containers.Indefinite_Holders is
   pragma Preelaborate (Indefinite_Holders);
   --  This package provides a "holder" of a definite type that
contains a
   --  single value of an indefinite type.
   --  This allows one to effectively declare an uninitialized
variable or
   --  component of an indefinite type.

   type Holder is tagged private;
   pragma Preelaborable_Initialization (Holder);
   --  The type Holder is used to represent holder containers. The
type Holder
   --  needs finalization (see 7.6).

   Empty_Holder : constant Holder;
   --  Empty_Holder represents an empty holder object. If an object of
type
   --  Holder is not otherwise initialized, it is initialized to the
same
   --  value as Empty_Holder.

   function "=" (Left, Right : Holder) return Boolean;
   --  If Left and Right denote the same holder object, then the
function
   --  returns True.
   --  Otherwise, it compares the element contained in Left to the
element
   --  contained in Right using the generic formal equality operator,
   --  returning The Result of that operation. Any exception raised
during
   --  the evaluation of element equality is propagated.

   function To_Holder (New_Item : Element_Type) return Holder;
   --  Returns a non-empty holder containing an element initialized to
   --  New_Item.

   function Is_Empty (Container : Holder) return Boolean;
   --  Returns True if the holder is empty, and False if it contains
an
   --  element.

   procedure Clear (Container : in out Holder);
   --  Removes the element from Container.

   function Element (Container : Holder) return Element_Type;
   --  If Container is empty, Constraint_Error is propagated.
   --  Otherwise, returns the element stored in Container.

   procedure Replace_Element (Container : in out Holder;
                              New_Item  :        Element_Type);
   --  Replace_Element assigns the value New_Item into Container,
replacing
   --  any preexisting content of Container. Container is not empty
   --  after a successful call to Replace_Element.

   procedure Query_Element
     (Container :                 Holder;
      Process   : not null access procedure (Element : Element_Type));
   --  If Container is empty, Constraint_Error is propagated.
   --  Otherwise, Query_Element calls Process.all with the contained
element
   --  as the argument. Program_Error is raised if Process.all tampers
with
   --  the elements of Container. Any exception raised by Process.all
is
   --  propagated.

   procedure Update_Element
     (Container :                 Holder;
      Process   : not null access procedure (Element : in out
Element_Type));
   --  If Container is empty, Constraint_Error is propagated.
   --  Otherwise, Query_Element calls Process.all with the contained
element
   --  as the argument. Program_Error is raised if Process.all tampers
with
   --  the elements of Container. Any exception raised by Process.all
is
   --  propagated.

   procedure Move (Target : in out Holder;
                   Source : in out Holder);
   --  If Target denotes the same object as Source, then Move has no
effect.
   --  Otherwise, the element contained by Source (if any) is removed
from
   --  Source and inserted into Target, replacing any preexisting
content.
   --  Source is empty after a successful call to Move.

private

   type Element_Ptr is access Element_Type;

   type Holder is new Ada.Finalization.Controlled with record
      Contents : Element_Ptr := null;
      Busy     : Natural     := 0;
   end record;

   procedure Adjust (Container : in out Holder);

   procedure Finalize (Container : in out Holder);

   use Ada.Streams;

   procedure Write (Stream    : access Root_Stream_Type'Class;
                    Container :        Holder);
   for Holder'Write use Write;

   procedure Read (Stream    : access Root_Stream_Type'Class;
                   Container : out    Holder);
   for Holder'Read use Read;

   Empty_Holder : constant Holder := (Ada.Finalization.Controlled with
                                      others => <>);

end Ada.Containers.Indefinite_Holders;

File: a-coinho.adb
with Ada.Unchecked_Deallocation;
with System;

package body Ada.Containers.Indefinite_Holders is

   procedure Free is
     new Ada.Unchecked_Deallocation (Element_Type, Element_Ptr);

   ---------
   -- "=" --
   ---------

   function "=" (Left, Right : Holder) return Boolean is
      use type System.Address;
   begin
      if Left'Address = Right'Address then
         return True;
      end if;
      if Is_Empty (Left) then
         return Is_Empty (Right);
      else
         return not Is_Empty (Right) and then Left.Contents.all =
Right.Contents.all;
      end if;
   end "=";

   ---------------
   -- To_Holder --
   ---------------

   function To_Holder (New_Item : Element_Type) return Holder is
   begin
      return (Ada.Finalization.Controlled with
              Contents => new Element_Type'(New_Item),
              Busy     => 0);
   end To_Holder;

   --------------
   -- Is_Empty --
   --------------

   function Is_Empty (Container : Holder) return Boolean is
   begin
      return Container.Contents = null;
   end Is_Empty;

   -----------
   -- Clear --
   -----------

   procedure Clear (Container : in out Holder) is
   begin
      if Container.Busy > 0 then
         raise Program_Error with "attempt to tamper with element
(holder is busy)";
      end if;
      if Container.Contents /= null then
         Free (Container.Contents);
         Container.Busy := 0;
      end if;
   end Clear;

   -------------
   -- Element --
   -------------

   function Element (Container : Holder) return Element_Type is
   begin
      if Container.Contents = null then
         raise Constraint_Error with "Container has no element";
      end if;
      return Container.Contents.all;
   end Element;

   ---------------------
   -- Replace_Element --
   ---------------------

   procedure Replace_Element (Container : in out Holder;
                              New_Item  :        Element_Type) is
   begin
      if Container.Busy > 0 then
         raise Program_Error with "attempt to tamper with element
(holder is busy)";
      end if;
      Clear (Container);
      Container.Contents := new Element_Type'(New_Item);
   end Replace_Element;

   -------------------
   -- Query_Element --
   -------------------

   procedure Query_Element
     (Container :                 Holder;
      Process   : not null access procedure (Element : Element_Type))
is
      H : Holder  renames Container'Unrestricted_Access.all;
      B : Natural renames H.Busy;
   begin
      if Container.Contents = null then
         raise Constraint_Error with "Container has no element";
      end if;
      B := B + 1;
      begin
         Process (Container.Contents.all);
      exception
         when others =>
            B := B - 1;
            raise;
      end;
      B := B - 1;
   end Query_Element;

   --------------------
   -- Update_Element --
   --------------------

   procedure Update_Element
     (Container :                 Holder;
      Process   : not null access procedure (Element : in out
Element_Type)) is
      H : Holder  renames Container'Unrestricted_Access.all;
      B : Natural renames H.Busy;
   begin
      if Container.Contents = null then
         raise Constraint_Error with "Container has no element";
      end if;
      B := B + 1;
      begin
         Process (Container.Contents.all);
      exception
         when others =>
            B := B - 1;
            raise;
      end;
      B := B - 1;
   end Update_Element;

   ----------
   -- Move --
   ----------

   procedure Move (Target : in out Holder;
                   Source : in out Holder) is
   begin
      if Target.Busy > 0 then
         raise Program_Error with "attempt to tamper with elements
(Target is busy)";
      end if;
      if Source.Busy > 0 then
         raise Program_Error with "attempt to tamper with elements
(Source is busy)";
      end if;
      if Target.Contents /= Source.Contents then
         Clear (Target);
         Target.Contents := Source.Contents;
         Source.Contents := null;
      end if;
   end Move;

   ------------
   -- Adjust --
   ------------

   procedure Adjust (Container : in out Holder) is
   begin
      if Container.Contents /= null then
         Container.Contents := new
Element_Type'(Container.Contents.all);
         Container.Busy     := 0;
      end if;
   end Adjust;

   --------------
   -- Finalize --
   --------------

   procedure Finalize (Container : in out Holder) is
   begin
      if Container.Busy > 0 then
         raise Program_Error with "attempt to tamper with element
(holder is busy)";
      end if;
      if Container.Contents /= null then
         Free (Container.Contents);
         Container.Busy := 0;
      end if;
   end Finalize;

   -----------
   -- Write --
   -----------

   procedure Write (Stream    : access Root_Stream_Type'Class;
                    Container :        Holder) is
      Is_Present : constant Boolean := Container.Contents /= null;
   begin
      Boolean'Write (Stream, Is_Present);
      if Is_Present then
         Element_Type'Output (Stream, Container.Contents.all);
      end if;
   end Write;

   ----------
   -- Read --
   ----------

   procedure Read (Stream    : access Root_Stream_Type'Class;
                   Container : out    Holder) is
      Is_Present : Boolean := Boolean'Input(Stream);
   begin
      Clear (Container);
      if Is_Present then
         Container.Contents := new Element_Type'(Element_Type'Input
(Stream));
      end if;
   end Read;

end Ada.Containers.Indefinite_Holders;

Usual caveats about no warrenties, etc. but other than that use as you
see fit! :-)

Here's a (very) small test / demo:

File: test_ai05_0068.adb
--pragma Warnings (Off);
with Ada.Containers.Indefinite_Holders;
--pragma Warnings (On);
with Ada.Exceptions;
with Ada.Text_IO;

procedure Test_AI05_0069 is

   package String_Holders is
     new Ada.Containers.Indefinite_Holders (String);

   My_String : String_Holders.Holder := String_Holders.To_Holder
("Hello World!");

   procedure Test_Query is
      procedure Do_Something (Element : String) is
      begin
         My_String.Clear;
      end Do_Something;
   begin
      My_String.Query_Element (Do_Something'Access);
   exception
      when E : Program_Error =>
         Ada.Text_Io.Put_Line ("Caught exception [" &
Ada.Exceptions.Exception_Name (E)
                               & "] with message [" &
Ada.Exceptions.Exception_Message (E) & "]");
   end Test_Query;

   procedure Test_Update is
      procedure Do_Something (Element : in out String) is
      begin
         My_String.Clear;
         Element := "asdasdas";
      end Do_Something;
   begin
      My_String.Update_Element (Do_Something'Access);
   exception
      when E : Program_Error =>
         Ada.Text_Io.Put_Line ("Caught exception [" &
Ada.Exceptions.Exception_Name (E)
                               & "] with message [" &
Ada.Exceptions.Exception_Message (E) & "]");
   end Test_Update;

   procedure Test_Move is
      My_Other_String : String_Holders.Holder :=
String_Holders.To_Holder ("s");
   begin
      Ada.Text_IO.Put_Line ("Source = [" & My_String.Element & "]");
      Ada.Text_IO.Put_Line ("Target = [" & My_Other_String.Element &
"]");
      String_Holders.Move (Source => My_String,
                           Target => My_Other_String);
      begin
         Ada.Text_Io.Put_Line ("Source = [" & My_String.Element &
"]");
      exception
         when E : Constraint_Error =>
            Ada.Text_Io.Put_Line ("Caught exception [" &
Ada.Exceptions.Exception_Name (E)
                                  & "] with message [" &
Ada.Exceptions.Exception_Message (E) & "]");
      end;
      Ada.Text_IO.Put_Line ("Target = [" & My_Other_String.Element &
"]");
   end Test_Move;

   type A_Record is record
      Component : String_Holders.Holder;
   end record;

   My_Record : A_Record;

begin
   Ada.Text_IO.Put_Line ("Is_Empty = " & Boolean'Image
(My_String.Is_Empty));
   My_String.Query_Element (Process => Ada.Text_IO.Put_Line'Access);
   Ada.Text_IO.Put_Line ("Element = [" & My_String.Element & "]");
   My_String.Replace_Element ("Wibble");
   My_String.Query_Element (Process => Ada.Text_Io.Put_Line'Access);
   Ada.Text_IO.Put_Line ("Element = [" & My_String.Element & "]");
   My_String.Clear;
   Ada.Text_Io.Put_Line ("Is_Empty = " & Boolean'Image
(My_String.Is_Empty));
   begin
      Ada.Text_Io.Put_Line ("Element = [" & My_String.Element & "]");
      Ada.Text_Io.Put_Line ("*** Should have raised exception");
   exception
      when E : Constraint_Error =>
         Ada.Text_Io.Put_Line ("Caught exception [" &
Ada.Exceptions.Exception_Name (E)
                               & "] with message [" &
Ada.Exceptions.Exception_Message (E) & "]");
   end;
   My_String.Replace_Element ("Wibble again");
   Test_Query;
   Test_Update;
   Test_Move;
exception
   when E : others =>
      Ada.Text_Io.Put_Line ("Caught unexpected exception [" &
Ada.Exceptions.Exception_Name (E)
                            & "] with message [" &
Ada.Exceptions.Exception_Message (E) & "]");
end Test_AI05_0069;

Remember to include a '-a' options when you build it with GNAT.

Cheers
-- Martin



^ permalink raw reply	[relevance 6%]

* Exceptions (was Re: How do I go about creating a minimal GNAT runtime?)
  @ 2009-02-10  2:34  5% ` anon
  0 siblings, 0 replies; 200+ results
From: anon @ 2009-02-10  2:34 UTC (permalink / raw)


To compile and execute a simple program that uses a raise statement 
such as in the following code:

    --
    -- Sample code
    --
    procedure test is
      begin
        raise Program_Error ;
      end test ;

you will need the following list of packages in your "rts/adainclude" and 
the *.ali stored in "rts/adalib". You will also need to build the 
"libgnat.a" by using the "ar r <list of object files>" command and store 
in the "rts/adalib" dir.


a-except.adb  -- Ada.Exceptions            Edited to conform to RM.
a-except.ads                               Simpler design. That removes
                                           most Import/Exports except for
                                           exports for the RChecks 
                                           routines.
                                           Rchecks routines defined in 
                                           body and are rewritten to use 
                                           Raise_Exception instead of 
                                           GNAT's complex algorithm. 
                              

a-unccon.ads  -- Ada.Unchecked_Conversion
ada.ads       -- Ada

s-secsta.adb  -- System.Secondary_Stack    Compiler uses this package for 
s-secsta.ads                               functions that return a string 
                                           value. Also requires
                                           System.Storage_Elements.

s-memory.adb  -- System.Memory             This is a test environmental
s-memory.ads                               package that simulates a heap
                                           Needs a true hardware memory 
                                           management.  That can handle 
                                           static and virtual system.

s-stalib.adb  -- System.Standard_Library   Defines standard Exceptions
s-stalib.ads                               and storage. Basically copied 
                                           from GNAT. 

s-stoele.adb  -- System.Storage_Elements   
s-stoele.ads

system.ads    -- System                    GNAT compiler based.

--
-- Extra packages use for output of exception message
--

g-io.adb      -- GNAT.IO                   use for Put/Put_Line/New_Line
g-io.ads                                   connects to Video_IO

gnat.ads      -- GNAT

video_io.adb  -- Video_IO                  Text/Graphic SAGA device driver
video_io.ads                              



The reason you must rewrite "Ada.Exceptions" is that it uses multiple 
c-to-os functions, which some are defined in:

System.CRTL   -- defines C RTL ( not used in an Ada only OS )
System.Memory -- defines C memory functions. ( Needs be defined 
                 Ada to CPU Memory routines first )
              -- In other words a complete memory management system 
              -- is needs to make this package fully functional, but
              -- it can be simulate by using a large array of bytes.
              -- 
cio.c         -- defines C RTS to OS for I/O operations.  Must be 
              -- converted to a complete sub-system. In my example 
              -- I used a modified "GNAT.IO" and the "Video_IO" 
              -- device driver.

Then there the "System.Soft_Links" package. Do you really need 
it.  In most cases, for the core of the kernel the answer is No!


Now there are some binder variables are procedures that needs to be 
define in Ada, they are normally found in "Initialize.c", "init.c", 
"finalize.c". In my example I create a package called "gnat_library"
to store these in Ada routines and variables.
#
#
#
rm test
gnat compile  gnat_library.adb --RTS=rts
#
gnat compile  test.adb         --RTS=rts
gnat bind     test.ali         --RTS=rts
#
# To make the routine executable, must move the "function main" to 
# the beginning of the ada_main package before compiling.
#
gnat compile  b~test.adb       --RTS=rts -gnatA -gnatWb -gnatiw -gnatws
#
#  gnatlink test.ali gnat_library.o -n -v -v --RTS=rts
#
#  Problem: Adds all gcc libraries and includes host Ada Library Path 
#           and in some case will cause linker to stop processing. So 
#           it still better to use the "gcc" program.
#
gcc  b~test.o gnat_library.o ./test.o text_io.o video_io.o --RTS=rts       \
     -o test -L./ -L/example/ada/gnat/rts/adalib/                          \
     /example/ada/gnat/rts/adalib/libgnat.a
#
#
#


In <eb511600-6446-4bad-b859-0d7444416a4c@d36g2000prf.googlegroups.com>, Lucretia <lucretia9@lycos.co.uk> writes:
>Hi (again),
>
>It's been a while, but I'm coming back to my Ada kernel again. I've
>been messing with my helo_world_kernel which I built using no runtime
>(see http://www.archeia.com for more info).
>
>Having just spoken to Ludovic on #Ada, he pointed out that the gnat
>tools can use a basic cross tool set, like the ones I have built
>myself (again, see the above link). My toolset comprises of a gnat1
>compiler and a gnatbind for my targets. I found that it does work
>using the --GCC and --GNATBIND flags, and I need to make sure the
>cross tools and the host tools are of the same GCC version otherwise
>GNAT throws up ALI format errors.
>
>The thing is, I've been trying to enable exceptions, but keep coming
>across big problems in that the runtime requires features that are
>being restricted, such as returning aggregates and assigning
>composites, returning unconstrained objects which requires the
>secondary stack. So, what I really need to know is, how do I create a
>runtime which is restricted in this way for bare hw access?
>
>Thanks,
>Luke.




^ permalink raw reply	[relevance 5%]

* Re: QtSql problem
  @ 2009-02-06  8:31  7%   ` Gautier
  0 siblings, 0 replies; 200+ results
From: Gautier @ 2009-02-06  8:31 UTC (permalink / raw)


Vadim Godunko wrote:

 > Can you please rebuild your program with the -E binder's switch? This
 > enables to store traceback information in the exception occurrence, so
 > we can see where the exception occurs.

He also may need to display the traceback...
------------------------------------------------------------------------------
--  File:            TB_Wrap.ads
--  Description:     Trace-back wrapper for GNAT 3.13p+ (spec.)
------------------------------------------------------------------------------

generic

   with procedure My_main_procedure;

procedure TB_Wrap;
------------------------------------------------------------------------------
--  File:            TB_Wrap.adb
--  Description:     Trace-back wrapper for GNAT 3.13p+ (body)
------------------------------------------------------------------------------

with GNAT.Traceback.Symbolic, Ada.Exceptions, Ada.Text_IO;
use Ada.Exceptions, Ada.Text_IO;

procedure TB_Wrap is
   --  pragma Compiler_options("-g");
   --  pragma Binder_options("-E");
begin
   My_main_procedure;
exception
   when E: others =>
     New_Line;
     Put_Line("--------------------[ Unhandled exception ]-----------------");
     Put_Line(" > Name of exception . . . . .: " &
              Ada.Exceptions.Exception_Name(E) );
     Put_Line(" > Message for exception . . .: " &
              Ada.Exceptions.Exception_Message(E) );
     Put_Line(" > Trace-back of call stack: " );
     Put_Line( GNAT.Traceback.Symbolic.Symbolic_Traceback(E) );
end TB_Wrap;
_________________________________________________________
Gautier's Ada programming -- http://sf.net/users/gdemont/
NB: For a direct answer, e-mail address on the Web site!



^ permalink raw reply	[relevance 7%]

* Re: cannot generate code for file a-excach.adb (subunit)
  2009-01-27 18:13  0%   ` Lucretia
@ 2009-01-27 22:43  0%     ` xavier grave
  0 siblings, 0 replies; 200+ results
From: xavier grave @ 2009-01-27 22:43 UTC (permalink / raw)


-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Lucretia a �crit :
> On Jan 27, 2:38 pm, xavier grave <xavier.gr...@ipno.in2p3.fr> wrote:
>> -----BEGIN PGP SIGNED MESSAGE-----
>> Hash: SHA1
>>
>> You need to include excach.adb source file but it is part of the
>> Ada.Exceptions package and is compiled when you compile a-except.adb
>> so you don't need to compile it.
> 
> Do you have any hints how to go about compiling raise-gcc.c? Or have
> you hacked a version specific to your runtime?

You should have a look (using viewMTN for example, see the post from
Ludovic) to the lovelace makefiles. In order to ease my life I'm
compiling locally and partially gnat and then I just need to take some
.o I need, for example raise-gcc.o

hope it will help, xavier
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.9 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org

iEYEARECAAYFAkl/jf4ACgkQVIZi0A5BZF6RFgCdFKnhba0nidlYk3TNFFRvDdC4
bdUAmwTJ/dEV6RqoyIoKPGR4jVayJhcn
=Tt8/
-----END PGP SIGNATURE-----



^ permalink raw reply	[relevance 0%]

* Re: cannot generate code for file a-excach.adb (subunit)
  2009-01-27 14:38  5% ` xavier grave
  2009-01-27 17:15  6%   ` Ludovic Brenta
@ 2009-01-27 18:13  0%   ` Lucretia
  2009-01-27 22:43  0%     ` xavier grave
  1 sibling, 1 reply; 200+ results
From: Lucretia @ 2009-01-27 18:13 UTC (permalink / raw)


On Jan 27, 2:38 pm, xavier grave <xavier.gr...@ipno.in2p3.fr> wrote:
> -----BEGIN PGP SIGNED MESSAGE-----
> Hash: SHA1
>
> You need to include excach.adb source file but it is part of the
> Ada.Exceptions package and is compiled when you compile a-except.adb
> so you don't need to compile it.

Do you have any hints how to go about compiling raise-gcc.c? Or have
you hacked a version specific to your runtime?

Luke.



^ permalink raw reply	[relevance 0%]

* Re: cannot generate code for file a-excach.adb (subunit)
  2009-01-27 14:38  5% ` xavier grave
@ 2009-01-27 17:15  6%   ` Ludovic Brenta
  2009-01-27 18:13  0%   ` Lucretia
  1 sibling, 0 replies; 200+ results
From: Ludovic Brenta @ 2009-01-27 17:15 UTC (permalink / raw)


The error message from GNAT is because Ada.Exceptions.Call_Chain is a
separate subprogram which is really part of the package
Ada.Exceptions; it is a subunit, not a child unit. GNAT refuses to
compile separate units separately; it will compile separate units when
it compiles their enclosing unit.

What this boils down to is:

gnatmake a-excach.adb

gives the error "cannot generate code for file a-excach.adb (subunit)"

gnatmake a-except.adb

compiles both a-except.adb and a-excach.adb into one object file, a-
except.o.

--
Ludovic Brenta.



^ permalink raw reply	[relevance 6%]

* Re: cannot generate code for file a-excach.adb (subunit)
  2009-01-27 14:21  7% cannot generate code for file a-excach.adb (subunit) Lucretia
@ 2009-01-27 14:38  5% ` xavier grave
  2009-01-27 17:15  6%   ` Ludovic Brenta
  2009-01-27 18:13  0%   ` Lucretia
  0 siblings, 2 replies; 200+ results
From: xavier grave @ 2009-01-27 14:38 UTC (permalink / raw)


-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

You need to include excach.adb source file but it is part of the
Ada.Exceptions package and is compiled when you compile a-except.adb
so you don't need to compile it.

As far as I remember...
xavier

Lucretia a �crit :
> Hi,
> 
> In my attempts to enable exceptions in my test kernel, I've come
> across a problem when building up my configurable runtime.
> 
> x86_64-unknown-elf-gcc -fno-pic -c -nostdinc -I. -ffunction-sections -
> fdata-sections -gnato -gnatE -m32 -g2 -gnatf -gnatu -gnatv -gnatpg a-
> excach.adb
> 
> GNAT 4.3.0
> Copyright 1992-2007, Free Software Foundation, Inc.
> 
> Unit name                        File name                     Time
> stamp
> ---------                        ---------
> ----------
> 
> Ada (spec)                       ada.ads
> 20070406091342
> Ada.Exceptions (spec)            a-except.ads
> 20070606104609
> Ada.Exceptions (body)            a-except.adb
> 20071213102130
> Ada.Exceptions.Call_Chain (body) a-excach.adb
> 20051115140645
> Ada.Unchecked_Conversion (spec)  a-unccon.ads
> 20070406091342
> System (spec)                    system.ads
> 20090127135815
> System.Exceptions (spec)         s-except.ads
> 20070912115821
> System.Parameters (spec)         s-parame.ads
> 20090127133535
> System.Soft_Links (spec)         s-soflin.ads
> 20071213103411
> System.Stack_Checking (spec)     s-stache.ads
> 20070912115821
> System.Standard_Library (spec)   s-stalib.ads
> 20070912115821
> System.Storage_Elements (spec)   s-stoele.ads
> 20070912115821
> System.Traceback (spec)          s-traceb.ads
> 20070912115821
> System.Traceback_Entries (spec)  s-traent.ads
> 20070912115821
> System.Wch_Con (spec)            s-wchcon.ads
> 20071213102052
> System.Wch_Stw (spec)            s-wchstw.ads
> 20071213102130
> 
> cannot generate code for file a-excach.adb (subunit)
> to check subunit for errors, use -gnatc
> 
> Compiling: a-excach.adb (source file time stamp: 2005-11-15 14:06:45)
>  76 lines: No errors
> make: *** [a-excach.o] Error 1
> 
> Compiling it with -gnatc returns no errors. I'm confused as to why it
> won't compile properly.
> 
> Thanks,
> Luke.

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.9 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org

iEYEARECAAYFAkl/HIMACgkQVIZi0A5BZF54lACfc5F2dF6qW6WJarlqrDDI19cE
/3QAn03PIsifQjamX13o50FCBZmpy00R
=sx51
-----END PGP SIGNATURE-----



^ permalink raw reply	[relevance 5%]

* cannot generate code for file a-excach.adb (subunit)
@ 2009-01-27 14:21  7% Lucretia
  2009-01-27 14:38  5% ` xavier grave
  0 siblings, 1 reply; 200+ results
From: Lucretia @ 2009-01-27 14:21 UTC (permalink / raw)


Hi,

In my attempts to enable exceptions in my test kernel, I've come
across a problem when building up my configurable runtime.

x86_64-unknown-elf-gcc -fno-pic -c -nostdinc -I. -ffunction-sections -
fdata-sections -gnato -gnatE -m32 -g2 -gnatf -gnatu -gnatv -gnatpg a-
excach.adb

GNAT 4.3.0
Copyright 1992-2007, Free Software Foundation, Inc.

Unit name                        File name                     Time
stamp
---------                        ---------
----------

Ada (spec)                       ada.ads
20070406091342
Ada.Exceptions (spec)            a-except.ads
20070606104609
Ada.Exceptions (body)            a-except.adb
20071213102130
Ada.Exceptions.Call_Chain (body) a-excach.adb
20051115140645
Ada.Unchecked_Conversion (spec)  a-unccon.ads
20070406091342
System (spec)                    system.ads
20090127135815
System.Exceptions (spec)         s-except.ads
20070912115821
System.Parameters (spec)         s-parame.ads
20090127133535
System.Soft_Links (spec)         s-soflin.ads
20071213103411
System.Stack_Checking (spec)     s-stache.ads
20070912115821
System.Standard_Library (spec)   s-stalib.ads
20070912115821
System.Storage_Elements (spec)   s-stoele.ads
20070912115821
System.Traceback (spec)          s-traceb.ads
20070912115821
System.Traceback_Entries (spec)  s-traent.ads
20070912115821
System.Wch_Con (spec)            s-wchcon.ads
20071213102052
System.Wch_Stw (spec)            s-wchstw.ads
20071213102130

cannot generate code for file a-excach.adb (subunit)
to check subunit for errors, use -gnatc

Compiling: a-excach.adb (source file time stamp: 2005-11-15 14:06:45)
 76 lines: No errors
make: *** [a-excach.o] Error 1

Compiling it with -gnatc returns no errors. I'm confused as to why it
won't compile properly.

Thanks,
Luke.



^ permalink raw reply	[relevance 7%]

* Re: Common exception handling
  2008-09-10 22:51  0%               ` Martin
@ 2008-09-11 14:57  0%                 ` Adam Beneschan
  0 siblings, 0 replies; 200+ results
From: Adam Beneschan @ 2008-09-11 14:57 UTC (permalink / raw)


On Sep 10, 3:51 pm, Martin <martin.do...@btopenworld.com> wrote:
> On Aug 29, 4:31 pm, Adam Beneschan <a...@irvine.com> wrote:
>
>
>
> > On Aug 29, 1:32 am, Martin <martin.do...@btopenworld.com> wrote:
>
> > > On 26 Aug, 15:43, Adam Beneschan <a...@irvine.com> wrote:
>
> > > > On Aug 26, 6:47 am, shaunpatter...@gmail.com wrote:
>
> > > > > Yeah, it looks like the extra layer of exception handling is the only
> > > > > way. I was hoping I could avoid that if possible.
>
> > > > No, I don't think it's the only way.  I'm surprised no one has
> > > > suggested this:
>
> > > >    exception
> > > >       when E : others =>
> > > >          Print_Test (Rec);
> > > >          declare
> > > >              use Ada.Exceptions;
> > > >          begin
> > > >              if Exception_Identity(E) = A'Identity then
> > > >                 ... handling for A
> > > >              elsif Exception_Identity(E) = B'Identity then
> > > >                 ... handling for B
> > > >              etc.
> > > >              else
> > > >                 ... handling for other exceptions you didn't expect,
> > > >                 ... but you certainly need to aware that it could
> > > >                 ... happen
> > > >                 raise;  --maybe
> > > >              end if;
> > > >          end;
>
> > > >                             -- Adam
>
> > > Surely you missed a smiley off this suggestion!!! :-)
>
> > Well, I do often post silly things without smileys and assume everyone
> > is astute enough to figure out that I was trying to be funny.  But I
> > wasn't being funny here.  Although the above looks somewhat ugly, I
> > can imagine that a solution of this sort may be entirely appropriate
> > in some cases. Suppose, for example, that the common code isn't just
> > at the beginning, but is also at the end, or maybe even in the middle;
> > the nested exception handler/reraise solution might not be so clean in
> > that case.  Another problem with the nested exception handler solution
> > is that it could incur extra overhead since exception raising isn't
> > necessarily cheap.  That shouldn't matter in most cases, but sometimes
> > it might.  So I don't understand why the above is so ridiculous as to
> > merit the comment you gave.
>
> > I would say, though, that if your exception-handling code gets that
> > complex, it might be time to think about declaring just one exception
> > and a separate data structure for passing additional exception info
> > around.
>
> >                                  -- Adam
>
> Sorry - back again!
>
> It was mostly the (to my eyes) sheer "ugliness" of the
> if..elsif..elsif..end if;.
>
> I find these sorts of structures very hard to follow (was there a
> sneeky 'and then <boolean_expression>' snuck into one of the
> branches???

That sort of argues for an extended "case" statement that is just
syntactic sugar for a series of equality comparisons.  (Dmitry alluded
to that up above.)  Without changing the language, I suppose you could
turn each "case" branch into a procedure and set up a search table
that maps Exception_ID's into procedure accesses.  Maybe that would be
a little less ugly.  Both of these ideas would be essentially
equivalent to the if/elsif/elsif... but perhaps more aesthetic.

However, I do *not* think it's necessarily a good idea to change the
structure around just for aesthetic reasons.  Using nested exception
handlers may look nicer, but to me this is a fundamentally different
control structure---which, as I mentioned, may break down if you also
have common code that needs to be performed *after* the specific code
for each exception.  I'd rather write something that looks a bit ugly
than twist the code around to make it fit into a control structure
that doesn't do as good job of reflecting how I see the problem at
hand.

                                 -- Adam





^ permalink raw reply	[relevance 0%]

* Re: Common exception handling
  2008-08-29 15:31  0%             ` Adam Beneschan
@ 2008-09-10 22:51  0%               ` Martin
  2008-09-11 14:57  0%                 ` Adam Beneschan
  0 siblings, 1 reply; 200+ results
From: Martin @ 2008-09-10 22:51 UTC (permalink / raw)


On Aug 29, 4:31 pm, Adam Beneschan <a...@irvine.com> wrote:
> On Aug 29, 1:32 am, Martin <martin.do...@btopenworld.com> wrote:
>
>
>
> > On 26 Aug, 15:43, Adam Beneschan <a...@irvine.com> wrote:
>
> > > On Aug 26, 6:47 am, shaunpatter...@gmail.com wrote:
>
> > > > Yeah, it looks like the extra layer of exception handling is the only
> > > > way. I was hoping I could avoid that if possible.
>
> > > No, I don't think it's the only way.  I'm surprised no one has
> > > suggested this:
>
> > >    exception
> > >       when E : others =>
> > >          Print_Test (Rec);
> > >          declare
> > >              use Ada.Exceptions;
> > >          begin
> > >              if Exception_Identity(E) = A'Identity then
> > >                 ... handling for A
> > >              elsif Exception_Identity(E) = B'Identity then
> > >                 ... handling for B
> > >              etc.
> > >              else
> > >                 ... handling for other exceptions you didn't expect,
> > >                 ... but you certainly need to aware that it could
> > >                 ... happen
> > >                 raise;  --maybe
> > >              end if;
> > >          end;
>
> > >                             -- Adam
>
> > Surely you missed a smiley off this suggestion!!! :-)
>
> Well, I do often post silly things without smileys and assume everyone
> is astute enough to figure out that I was trying to be funny.  But I
> wasn't being funny here.  Although the above looks somewhat ugly, I
> can imagine that a solution of this sort may be entirely appropriate
> in some cases. Suppose, for example, that the common code isn't just
> at the beginning, but is also at the end, or maybe even in the middle;
> the nested exception handler/reraise solution might not be so clean in
> that case.  Another problem with the nested exception handler solution
> is that it could incur extra overhead since exception raising isn't
> necessarily cheap.  That shouldn't matter in most cases, but sometimes
> it might.  So I don't understand why the above is so ridiculous as to
> merit the comment you gave.
>
> I would say, though, that if your exception-handling code gets that
> complex, it might be time to think about declaring just one exception
> and a separate data structure for passing additional exception info
> around.
>
>                                  -- Adam

Sorry - back again!

It was mostly the (to my eyes) sheer "ugliness" of the
if..elsif..elsif..end if;.

I find these sorts of structures very hard to follow (was there a
sneeky 'and then <boolean_expression>' snuck into one of the
branches???

-- Martin



^ permalink raw reply	[relevance 0%]

* Re: Very confused by Ada tasking, can not explain the execution outcome.
  @ 2008-08-30 13:40  6%     ` Georg Bauhaus
  0 siblings, 0 replies; 200+ results
From: Georg Bauhaus @ 2008-08-30 13:40 UTC (permalink / raw)


climber.cui@gmail.com wrote:
> On Aug 30, 1:12 am, "Jeffrey R. Carter"

>> If an exception occurs in your task, the task will terminate silently. This is a
>> way your task and program could terminate although it never increments Rounds
>> nor executes its final statement.

> Thanks Jeff. It seems you are right.  Some exceptions occurs during
> the task execution, and Ada is ignoring it.

Ada is not actually ignoring exceptions in tasks; the program
is following the Ada rules: Add these lines,

      Put_Line("TASK EXITS ::  rounds =" & INTEGER'Image(rounds) &
        "...." );

   exception
      when X: others =>
         Put_Line("TASK failed due to " &
           Ada.Exceptions.Exception_Information(X));
   end User_thread;

and you should see something like
TASK failed due to Exception name: CONSTRAINT_ERROR
Message: multi_res_alloc_a.adb:131 index check failed

So, yes,
> It is very likely to the
> 'array index out of bound'.



>  I doubt that Ada follows the strict
> evaluation rules when it evaluates the boolean expressions,

you would specify short circuit evaluation using "and then"
etc. as explained by Damien Carbonne;  Ada follows the rules
defined in the LRM, section

 "4.5.1 Logical Operators and Short-circuit Control Forms"




^ permalink raw reply	[relevance 6%]

* Re: Common exception handling
  2008-08-29  8:32  0%           ` Martin
@ 2008-08-29 15:31  0%             ` Adam Beneschan
  2008-09-10 22:51  0%               ` Martin
  0 siblings, 1 reply; 200+ results
From: Adam Beneschan @ 2008-08-29 15:31 UTC (permalink / raw)


On Aug 29, 1:32 am, Martin <martin.do...@btopenworld.com> wrote:
> On 26 Aug, 15:43, Adam Beneschan <a...@irvine.com> wrote:
>
>
>
> > On Aug 26, 6:47 am, shaunpatter...@gmail.com wrote:
>
> > > Yeah, it looks like the extra layer of exception handling is the only
> > > way. I was hoping I could avoid that if possible.
>
> > No, I don't think it's the only way.  I'm surprised no one has
> > suggested this:
>
> >    exception
> >       when E : others =>
> >          Print_Test (Rec);
> >          declare
> >              use Ada.Exceptions;
> >          begin
> >              if Exception_Identity(E) = A'Identity then
> >                 ... handling for A
> >              elsif Exception_Identity(E) = B'Identity then
> >                 ... handling for B
> >              etc.
> >              else
> >                 ... handling for other exceptions you didn't expect,
> >                 ... but you certainly need to aware that it could
> >                 ... happen
> >                 raise;  --maybe
> >              end if;
> >          end;
>
> >                             -- Adam
>
> Surely you missed a smiley off this suggestion!!! :-)

Well, I do often post silly things without smileys and assume everyone
is astute enough to figure out that I was trying to be funny.  But I
wasn't being funny here.  Although the above looks somewhat ugly, I
can imagine that a solution of this sort may be entirely appropriate
in some cases. Suppose, for example, that the common code isn't just
at the beginning, but is also at the end, or maybe even in the middle;
the nested exception handler/reraise solution might not be so clean in
that case.  Another problem with the nested exception handler solution
is that it could incur extra overhead since exception raising isn't
necessarily cheap.  That shouldn't matter in most cases, but sometimes
it might.  So I don't understand why the above is so ridiculous as to
merit the comment you gave.

I would say, though, that if your exception-handling code gets that
complex, it might be time to think about declaring just one exception
and a separate data structure for passing additional exception info
around.

                                 -- Adam




^ permalink raw reply	[relevance 0%]

* Re: Common exception handling
  2008-08-26 14:43  6%         ` Adam Beneschan
  2008-08-26 15:10  0%           ` Dmitry A. Kazakov
@ 2008-08-29  8:32  0%           ` Martin
  2008-08-29 15:31  0%             ` Adam Beneschan
  1 sibling, 1 reply; 200+ results
From: Martin @ 2008-08-29  8:32 UTC (permalink / raw)


On 26 Aug, 15:43, Adam Beneschan <a...@irvine.com> wrote:
> On Aug 26, 6:47 am, shaunpatter...@gmail.com wrote:
>
> > Yeah, it looks like the extra layer of exception handling is the only
> > way. I was hoping I could avoid that if possible.
>
> No, I don't think it's the only way.  I'm surprised no one has
> suggested this:
>
>    exception
>       when E : others =>
>          Print_Test (Rec);
>          declare
>              use Ada.Exceptions;
>          begin
>              if Exception_Identity(E) = A'Identity then
>                 ... handling for A
>              elsif Exception_Identity(E) = B'Identity then
>                 ... handling for B
>              etc.
>              else
>                 ... handling for other exceptions you didn't expect,
>                 ... but you certainly need to aware that it could
>                 ... happen
>                 raise;  --maybe
>              end if;
>          end;
>
>                             -- Adam

Surely you missed a smiley off this suggestion!!! :-)

== Martin



^ permalink raw reply	[relevance 0%]

* Re: Common exception handling
  2008-08-26 15:10  0%           ` Dmitry A. Kazakov
@ 2008-08-26 16:49  0%             ` Adam Beneschan
  0 siblings, 0 replies; 200+ results
From: Adam Beneschan @ 2008-08-26 16:49 UTC (permalink / raw)


On Aug 26, 8:10 am, "Dmitry A. Kazakov" <mail...@dmitry-kazakov.de>
wrote:
> On Tue, 26 Aug 2008 07:43:20 -0700 (PDT), Adam Beneschan wrote:
> > On Aug 26, 6:47 am, shaunpatter...@gmail.com wrote:
> >> Yeah, it looks like the extra layer of exception handling is the only
> >> way. I was hoping I could avoid that if possible.
>
> > No, I don't think it's the only way.  I'm surprised no one has
> > suggested this:
>
> >    exception
> >       when E : others =>
> >          Print_Test (Rec);
> >          declare
> >              use Ada.Exceptions;
> >          begin
> >              if Exception_Identity(E) = A'Identity then
> >                 ... handling for A
> >              elsif Exception_Identity(E) = B'Identity then
> >                 ... handling for B
> >              etc.
> >              else
> >                 ... handling for other exceptions you didn't expect,
> >                 ... but you certainly need to aware that it could
> >                 ... happen
> >                 raise;  --maybe
> >              end if;
> >          end;
>
> Hmm, it looks quite ugly, IMO. Exception handler (case-like) is better
> structured, cleaner, and possibly more efficient.
>
> ---------
> If exceptions were first-class citizens allowed in case statements then:
>
>    exception
>       when E : others =>
>          Print_Test (Rec);
>          case E is            -- This is not Ada, alas!
>             when A => ...
>             when B => ...
>             when others => ...
>          end case;

Maybe this use of CASE should be allowed, even if we don't go all the
way and make exceptions first-class entities in other ways.  What does
anyone else think... would it be a worthwhile feature to propose
adding?  Or is it just too "special" (if we added this, others would
ask, well why shouldn't we allow CASE on a string, or a record, or a
container, or just expand it using some user-specified relational
operator so that we can use it for everything...)?

                            -- Adam



^ permalink raw reply	[relevance 0%]

* Re: Common exception handling
  2008-08-26 14:43  6%         ` Adam Beneschan
@ 2008-08-26 15:10  0%           ` Dmitry A. Kazakov
  2008-08-26 16:49  0%             ` Adam Beneschan
  2008-08-29  8:32  0%           ` Martin
  1 sibling, 1 reply; 200+ results
From: Dmitry A. Kazakov @ 2008-08-26 15:10 UTC (permalink / raw)


On Tue, 26 Aug 2008 07:43:20 -0700 (PDT), Adam Beneschan wrote:

> On Aug 26, 6:47 am, shaunpatter...@gmail.com wrote:

>> Yeah, it looks like the extra layer of exception handling is the only
>> way. I was hoping I could avoid that if possible.
> 
> No, I don't think it's the only way.  I'm surprised no one has
> suggested this:
> 
>    exception
>       when E : others =>
>          Print_Test (Rec);
>          declare
>              use Ada.Exceptions;
>          begin
>              if Exception_Identity(E) = A'Identity then
>                 ... handling for A
>              elsif Exception_Identity(E) = B'Identity then
>                 ... handling for B
>              etc.
>              else
>                 ... handling for other exceptions you didn't expect,
>                 ... but you certainly need to aware that it could
>                 ... happen
>                 raise;  --maybe
>              end if;
>          end;

Hmm, it looks quite ugly, IMO. Exception handler (case-like) is better
structured, cleaner, and possibly more efficient.

---------
If exceptions were first-class citizens allowed in case statements then:

   exception
      when E : others =>
         Print_Test (Rec);
         case E is            -- This is not Ada, alas!
            when A => ...
            when B => ...
            when others => ...
         end case;

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de



^ permalink raw reply	[relevance 0%]

* Re: Common exception handling
  @ 2008-08-26 14:43  6%         ` Adam Beneschan
  2008-08-26 15:10  0%           ` Dmitry A. Kazakov
  2008-08-29  8:32  0%           ` Martin
  0 siblings, 2 replies; 200+ results
From: Adam Beneschan @ 2008-08-26 14:43 UTC (permalink / raw)


On Aug 26, 6:47 am, shaunpatter...@gmail.com wrote:
> Yeah, it looks like the extra layer of exception handling is the only
> way. I was hoping I could avoid that if possible.

No, I don't think it's the only way.  I'm surprised no one has
suggested this:

   exception
      when E : others =>
         Print_Test (Rec);
         declare
             use Ada.Exceptions;
         begin
             if Exception_Identity(E) = A'Identity then
                ... handling for A
             elsif Exception_Identity(E) = B'Identity then
                ... handling for B
             etc.
             else
                ... handling for other exceptions you didn't expect,
                ... but you certainly need to aware that it could
                ... happen
                raise;  --maybe
             end if;
         end;

                            -- Adam




^ permalink raw reply	[relevance 6%]

* Re: Common exception handling
  2008-08-26 12:48  5%   ` Ludovic Brenta
@ 2008-08-26 12:58  0%     ` Martin
    0 siblings, 1 reply; 200+ results
From: Martin @ 2008-08-26 12:58 UTC (permalink / raw)


On Aug 26, 1:48 pm, Ludovic Brenta <ludo...@ludovic-brenta.org> wrote:
[snip]
> If all you want it to print the name of the exception, it is better
> like this:
>
> exception
>    when E : others =>
>       Put_Line (Ada.Exceptions.Exception_Name (E));
>
> --
> Ludovic Brenta.

Yes, it was just a method of demonstrating the different paths that
have been exercised.

Cheers
-- Martin



^ permalink raw reply	[relevance 0%]

* Re: Common exception handling
  @ 2008-08-26 12:48  5%   ` Ludovic Brenta
  2008-08-26 12:58  0%     ` Martin
  0 siblings, 1 reply; 200+ results
From: Ludovic Brenta @ 2008-08-26 12:48 UTC (permalink / raw)


Martin wrote:
>    exception
>       when A =>
>          Put_Line ("A");
>       when B =>
>          Put_Line ("B");
>       when C =>
>          Put_Line ("C");
>       when others =>
>          Put_Line ("others");

If all you want it to print the name of the exception, it is better
like this:

exception
   when E : others =>
      Put_Line (Ada.Exceptions.Exception_Name (E));

--
Ludovic Brenta.



^ permalink raw reply	[relevance 5%]

* Re: How to implement a server socket compatible to telnet?
  @ 2008-08-20 22:57  0%   ` anon
  0 siblings, 0 replies; 200+ results
From: anon @ 2008-08-20 22:57 UTC (permalink / raw)


But he wants to deal with Telnet.  It states that in the title.

And actually, a complete program PingPong is coded in the file 
"GNAT.Sockets.ads " which deals with both server and client code. 

Like I say KNOW your compiler and its packages That way you might be 
able to skip spending time seaching the internet or books.


In <0baa592d-1291-4298-90e3-88ca85a476a8@k13g2000hse.googlegroups.com>, "snoopysalive@googlemail.com" <snoopysalive@googlemail.com> writes:
>Come on guys, stop arguing. In the end, I've found a solution:
>
>-----------------------------------------------------------------------
>with Ada.Text_IO,
>     Ada.Exceptions,
>	 Ada.Streams,
>	 Ada.Unchecked_Deallocation,
>     GNAT.Sockets;
>use Ada.Text_IO,
>    Ada.Exceptions,
>    Ada.Streams,
>    GNAT.Sockets;
>
>procedure IP_Server is
>
>	BUFFER_SIZE : constant Positive := 1024;
>
>	type String_Access is access all String;
>
>	procedure Free is new Ada.Unchecked_Deallocation
>		(String, String_Access);
>
>	CRLF : constant String := ASCII.CR & ASCII.LF;
>	Host : constant String := "localhost";
>	Port : Port_Type       := 7777;
>
>	Address : Sock_Addr_Type;
>	Server  : Socket_Type;
>	Client  : Socket_Type;
>	Channel : Stream_Access;
>
>	Data   : Stream_Element_Array (1..1);
>	Offset : Stream_Element_Count;
>
>	Buffer : String_Access := new String (1..BUFFER_SIZE);
>	Cnt    : Natural := 0;
>
>	Test : Float := 0.0;
>
>begin -- IP_Server
>	Initialize;
>
>	Address.Addr := Addresses (Get_Host_By_Name (Host), 1);
>	Address.Port := Port;
>
>	Create_Socket (Server);
>	Set_Socket_Option (Server, Socket_Level, (Reuse_Address, True));
>	Bind_Socket (Server, Address);
>	Listen_Socket (Server);
>	Accept_Socket (Server, Client, Address);
>	Channel := Stream (Client);
>
>	Cnt := 0;
>	loop
>		Read (Channel.all, Data (1..1), Offset);
>		if Character'Val (Data (1)) = ASCII.CR  or
>		   Character'Val (Data (1)) = ASCII.LF  or
>		   Character'Val (Data (1)) = ASCII.NUL or
>		   Offset = 0 then
>			exit;
>		else
>			Cnt := Cnt + 1;
>			Buffer.all (Cnt) := Character'Val (Data (1));
>		end if;
>	end loop;
>	-- Read values from client-stream character by character.
>	-- Reading should be stopped when Windows-linefeed or
>	-- NULL was found, because telnet seams to be sending
>	-- strings in a Windows-like format including the
>	-- terminating \0-character known from C-strings.
>
>	declare
>		Old : String_Access := Buffer;
>	begin
>		Buffer := new String'(Buffer (1..Cnt));
>		Free (Old);
>	end;
>	-- The buffer-size of Str is 1024 elements. It's necessary
>	-- to create a new String containing only relevant characters
>	-- for being able to process the message further.
>
>	declare
>		Pong : String := "pong" & CRLF;
>		O    : Stream_Element_Array (1..Pong'length);
>	begin
>		if Buffer.all = "ping" then
>			for I in Pong'range loop
>				O (Stream_Element_Offset (I)) := Character'Pos (Pong (I));
>			end loop;
>			Write (Channel.all, O);
>		end if;
>	end;
>	-- If Buffer's message equals "ping" the server will
>	-- send "pong" to the client. "pong" must be casted
>	-- from String to Stream_Element_Array first.
>
>	Close_Socket (Client);
>	Close_Socket (Server);
>
>	Finalize;
>
>exception when E : Socket_Error =>
>	Put_Line (Standard_Error, "Socket_Error => " & Exception_Message
>(E));
>
>end IP_Server;
>-----------------------------------------------------------------------------------
>
>Thanks to the thread under http://groups.google.com/group/comp.lang.ada/browse_thread/thread/c58b7bd180ea81b2
>I found out how to read character by character from the client.
>However, it's not very comfortable to cast the echo-string manually
>but it's better than not being able to communicate with telnet or
>other C-based clients.
>
>Bye,
>Matthias




^ permalink raw reply	[relevance 0%]

Results 1-200 of ~800   | reverse | options above
-- pct% links below jump to the message on this page, permalinks otherwise --
2008-08-08 11:31     How to implement a server socket compatible to telnet? snoopysalive
2008-08-20 21:25     ` snoopysalive
2008-08-20 22:57  0%   ` anon
2008-08-26 12:17     Common exception handling shaunpatterson
2008-08-26 12:39     ` Martin
2008-08-26 12:48  5%   ` Ludovic Brenta
2008-08-26 12:58  0%     ` Martin
2008-08-26 13:47           ` shaunpatterson
2008-08-26 14:43  6%         ` Adam Beneschan
2008-08-26 15:10  0%           ` Dmitry A. Kazakov
2008-08-26 16:49  0%             ` Adam Beneschan
2008-08-29  8:32  0%           ` Martin
2008-08-29 15:31  0%             ` Adam Beneschan
2008-09-10 22:51  0%               ` Martin
2008-09-11 14:57  0%                 ` Adam Beneschan
2008-08-30  1:54     Very confused by Ada tasking, can not explain the execution outcome climber.cui
2008-08-30  5:12     ` Jeffrey R. Carter
2008-08-30  9:42       ` climber.cui
2008-08-30 13:40  6%     ` Georg Bauhaus
2009-01-24 20:47     How do I go about creating a minimal GNAT runtime? Lucretia
2009-02-10  2:34  5% ` Exceptions (was Re: How do I go about creating a minimal GNAT runtime?) anon
2009-01-27 14:21  7% cannot generate code for file a-excach.adb (subunit) Lucretia
2009-01-27 14:38  5% ` xavier grave
2009-01-27 17:15  6%   ` Ludovic Brenta
2009-01-27 18:13  0%   ` Lucretia
2009-01-27 22:43  0%     ` xavier grave
2009-02-06  4:43     QtSql problem tworoses1
2009-02-06  8:27     ` Vadim Godunko
2009-02-06  8:31  7%   ` Gautier
2009-03-11 20:26     Newbie question -- dereferencing access Tim Rowe
2009-03-11 20:46     ` Ludovic Brenta
2009-03-12  9:57       ` Tim Rowe
2009-03-12 12:13         ` christoph.grein
2009-03-12 13:30           ` Ed Falis
2009-03-13  9:55             ` Tim Rowe
2009-03-13 11:06               ` Alex R. Mosteo
2009-03-13 16:31                 ` Tim Rowe
2009-03-13 17:33  6%               ` Martin
2009-05-15 16:26     Interrupt handler and Ada.Real_Time.Timing_Events Reto Buerki
2009-05-16 11:05  5% ` Timing Example was " anon
2009-06-23 21:52  3% Issue with GNAT GPL 2009 and GtkAda Damien Carbonne
2009-06-24  7:40  4% ` Dmitry A. Kazakov
2009-06-24  9:37  6% Not visible Pietro Tornaindietro
2009-06-24  9:56  0% ` Georg Bauhaus
2009-06-28 23:08     unsigned type anon
2009-07-01  1:39     ` Adam Beneschan
2009-07-02 19:49  5%   ` anon
2009-07-03  1:42  0%     ` anon
2009-08-02 17:47     writing on terminal before an exception Mark Fabbri
2009-08-03 20:40     ` vlc
2009-08-03 22:29       ` Yannick Duchêne Hibou57
2009-08-04  0:14  4%     ` Adam Beneschan
2009-08-05 10:40  6% Gnatbench 2.3.1 doing funny thing - any ideas? John McCabe
2010-01-16  0:04     Addr2Line2Locations for GPS Hibou57 (Yannick Duchêne)
2010-01-18 10:59     ` Emmanuel Briot
2010-01-18 13:38       ` Hibou57 (Yannick Duchêne)
2010-01-19 10:23  5%     ` franck
2010-01-19 13:49  7%       ` Gautier write-only
2010-03-15 20:59  4% Using gnat & ncurses Warren
2010-04-21 16:43     How to access this package written in C? resander
2010-04-21 17:39  6% ` Dmitry A. Kazakov
2010-08-01 12:17     S-expression I/O in Ada Natacha Kerensikova
2010-08-01 12:53     ` Dmitry A. Kazakov
2010-08-01 17:35       ` Natacha Kerensikova
2010-08-01 18:49         ` Dmitry A. Kazakov
2010-08-01 20:06           ` Natacha Kerensikova
2010-08-01 21:13             ` Dmitry A. Kazakov
2010-08-07  7:23               ` Natacha Kerensikova
2010-08-07 15:38                 ` Jeffrey Carter
2010-08-07 17:01                   ` Natacha Kerensikova
2010-08-08 10:26                     ` Simon Wright
2010-08-08 11:44  6%                   ` Dmitry A. Kazakov
2010-08-08 11:48  0%                     ` Dmitry A. Kazakov
2010-10-19 23:40     not catching exceptions mark
2010-10-20  8:11  6% ` Ludovic Brenta
2010-10-21  1:25  0%   ` mark
2010-11-08 20:34     GNAT's Protected Objects Jeffrey Carter
2010-11-08 21:38     ` Anh Vo
2010-11-08 22:32  6%   ` Jeffrey Carter
2010-11-09  1:50  0%     ` Anh Vo
2010-11-09 10:18  0%     ` Egil Høvik
2011-01-22  0:04     User Defined Storage Pool : did you ever experiment with it ? Yannick Duchêne (Hibou57)
2011-01-22  9:47  4% ` User Defined Storage Pool : Example anon
2011-02-28 17:27     Forcing Exception Handling iloAda
2011-02-28 20:38     ` Georg Bauhaus
2011-03-01  0:19       ` Shark8
2011-03-01  8:56         ` Dmitry A. Kazakov
2011-03-01  9:34           ` iloAda
2011-03-01  9:51  5%         ` Dmitry A. Kazakov
2011-03-01 10:07  0%           ` iloAda
2011-03-22 23:34     Text parsing package Syntax Issues
2011-03-23  8:32     ` Dmitry A. Kazakov
2011-03-23 11:19  5%   ` Syntax Issues
2011-07-27 16:29  5% Aspect programming Anh Vo
2011-08-04  7:54     XMLAda and GDB on Lion anybody? MRE
2011-08-04 12:04  4% ` Simon Wright
2011-12-15 14:09     Does OpenToken support Unicode mtrenkmann
2011-12-17  0:58     ` Stephen Leake
2012-01-23 22:03  4%   ` mtrenkmann
2012-01-23 22:48  4%   ` mtrenkmann
2012-01-24 13:47  0%     ` Stephen Leake
2012-01-20 15:03  5% Tracing procedural calls when an exception is raised tonyg
2012-01-27 16:22     OpenToken: Handling the empty word token mtrenkmann
2012-01-28 10:46     ` Stephen Leake
2012-01-30 16:28  2%   ` mtrenkmann
2012-04-11  3:18     Does Ada still competitive? Sunny
2012-04-11 20:19     ` anon
2012-04-12  5:56       ` J-P. Rosen
2012-04-13  9:06  4%     ` anon
2012-04-15  7:00  0%       ` J-P. Rosen
2012-04-27 18:56     Ada on Nintendo DS ? Natasha Kerensikova
2012-04-28  7:19  4% ` Stephen Leake
2012-04-28 13:43  0%   ` Natasha Kerensikova
2012-05-11  3:49     understanding runtime support Patrick
2012-05-15 14:48  5% ` Lucretia
2012-06-14 14:38     Is Text_IO.Put_Line() thread-safe? Dmitry A. Kazakov
2012-06-14 21:14  6% ` tmoran
2012-06-20 13:39     about the new Ada 2012 pre/post conditions Nasser M. Abbasi
2012-06-20 14:13     ` Dmitry A. Kazakov
2012-06-20 14:24       ` Nasser M. Abbasi
2012-06-20 14:37         ` Dmitry A. Kazakov
2012-06-21 20:32           ` Randy Brukardt
2012-06-22  7:23             ` Dmitry A. Kazakov
2012-06-22 19:41               ` Randy Brukardt
2012-06-22 23:08                 ` Dmitry A. Kazakov
2012-06-23 10:46                   ` Georg Bauhaus
2012-06-23 11:01                     ` Dmitry A. Kazakov
2012-06-24 14:59                       ` Georg Bauhaus
2012-06-24 16:06                         ` Dmitry A. Kazakov
2012-06-24 19:51  4%                       ` Georg Bauhaus
2012-07-23 21:42  5% Ada.Calendar and NTP (and Unix Epoch) erlo
2012-07-23 22:07  0% ` Adam Beneschan
2012-07-30 19:51     OS X 10.8 Mountain Lion and GNAT GPL 2012 Bill Findlay
2012-09-16  8:58     ` Blady
2012-09-17  8:20       ` Jerry
2012-09-17 12:13         ` Bill Findlay
2012-09-18  1:06           ` Jerry
2012-09-18 15:54             ` Bill Findlay
2012-09-19  1:00  5%           ` Jerry
2012-09-07 22:05     Help writing first daemon Patrick
2012-09-09  7:26  4% ` Help writing first daemon Heres a Server anon
2012-10-20  0:35     ZLIB_ERROR with AWS Okasu
2012-10-20  7:23     ` Okasu
2012-10-20  7:47       ` Dmitry A. Kazakov
2012-10-20  8:32         ` Okasu
2012-10-20  9:04  5%       ` Dmitry A. Kazakov
2012-10-20 20:46  0%         ` Okasu
2012-10-20 20:58               ` Pascal Obry
2012-10-20 21:15                 ` Okasu
2012-10-20 21:25                   ` Pascal Obry
2012-10-20 21:30                     ` Okasu
2012-10-20 22:26  0%                   ` Okasu
2012-10-21  6:17  0%           ` darkestkhan
2012-10-30 22:03     Tasking troubles, unexpected termination Shark8
2012-10-30 23:01     ` Adam Beneschan
2012-10-31  1:05       ` Anh Vo
2012-10-31  2:17  5%     ` Shark8
2012-11-23 17:17     Sockets Example Sought Robert Love
2012-11-28  4:43  4% ` anon
2013-02-09  1:52  7% Assertion_Policy implementation regarding Aspect Features Anh Vo
2013-02-15  3:55     Class wide preconditions: error in GNAT implementation? ytomino
2013-02-16  1:01     ` Randy Brukardt
2013-02-16 20:23  5%   ` Simon Wright
2013-03-07 18:04     Ada and OpenMP Rego, P.
2013-03-07 20:04     ` Ludovic Brenta
2013-03-07 22:22       ` Peter C. Chapin
2013-03-07 23:42         ` Randy Brukardt
2013-03-08  1:15           ` Shark8
2013-03-08  3:42             ` Randy Brukardt
2013-03-08 16:52               ` Shark8
2013-03-08 23:36                 ` Randy Brukardt
2013-03-09  4:13  6%               ` Brad Moore
2013-03-10  4:24  0%                 ` Randy Brukardt
2013-03-11 10:37     Bootstrapping a null procedure. Seriously?! Diogenes
2013-03-13  4:34  5% ` anon
2013-03-11 19:42  6% Is this expected behavior or not Anh Vo
2013-03-18 20:59     Runtime startup code for the GNAT Runtime...and a bit of humble pie Diogenes
2013-03-26 21:27     ` Diogenes
2013-03-26 21:57       ` Shark8
2013-03-27  0:28  5%     ` Diogenes
2013-03-27 10:05  0%       ` Brian Drummond
2013-03-30 20:01  5% Extended Exceptions and other tweaks Diogenes
2013-03-30 22:10  0% ` Brian Drummond
2013-03-31 13:55  0%   ` Luke A. Guest
2013-03-31 11:41  0% ` Stephen Leake
2013-04-23 20:30  4% Gnat Version 4.5.4 v protected objects v tasking stvcook53
2013-04-28  5:14     Seeking for papers about tagged types vs access to subprograms Yannick Duchêne (Hibou57)
2013-04-30  0:31     ` Yannick Duchêne (Hibou57)
2013-05-06 10:00       ` Yannick Duchêne (Hibou57)
2013-05-06 10:18         ` Dmitry A. Kazakov
2013-05-06 10:55           ` Yannick Duchêne (Hibou57)
2013-05-06 12:11             ` Dmitry A. Kazakov
2013-05-06 13:16               ` Yannick Duchêne (Hibou57)
2013-05-06 14:16                 ` Dmitry A. Kazakov
2013-05-06 15:15  6%               ` Yannick Duchêne (Hibou57)
2013-05-06 18:55  0%                 ` Dmitry A. Kazakov
2013-07-07 18:37     GCC 4.8.1 for Mac OS X Simon Wright
2013-07-17 19:57     ` Felix Krause
2013-07-17 21:00  6%   ` Simon Wright
2013-07-30 14:45  5% Ada exception vulnerability? Diogenes
2013-07-30 21:30  5% ` erlo
2013-08-09 16:50     4 beginner's questions on the PL Ada Emanuel Berg
2013-08-09 17:09     ` Adam Beneschan
2013-08-09 19:01       ` Randy Brukardt
2013-08-09 21:38         ` Emanuel Berg
2013-08-09 22:00           ` Jeffrey Carter
2013-08-09 22:16             ` Emanuel Berg
2013-08-10  0:39               ` Anh Vo
2013-08-10  1:24                 ` Emanuel Berg
2013-08-12 17:39  5%               ` Anh Vo
2013-08-12 19:57  0%                 ` Simon Wright
2013-08-12 20:13  0%                   ` Anh Vo
2014-02-14 12:38     confusing string error agent
2014-02-14 13:03     ` Jacob Sparre Andersen
2014-02-15  0:46       ` agent
2014-02-15  9:33         ` Simon Wright
2014-02-15 12:53           ` agent
2014-02-15 16:58             ` adambeneschan
2014-02-15 18:29  5%           ` Simon Wright
2014-02-17 12:57  0%             ` agent
2014-02-26  3:29  5% Class Wide Type Invariants - My bug or compiler bug Anh Vo
2014-03-19 13:24     Augusta: An open source Ada 2012 compiler (someday?) Peter Chapin
2014-03-20 10:23     ` Lucretia
2014-03-20 10:49       ` J-P. Rosen
2014-03-20 23:15         ` Randy Brukardt
2014-03-24  8:18           ` J Kimball
2014-03-25 19:41             ` Michael B.
2014-03-26  1:50               ` Shark8
2014-03-26 20:39                 ` Simon Clubley
2014-03-27  9:32                   ` Shark8
2014-03-27 20:02                     ` Simon Clubley
2014-03-27 20:38                       ` Lucretia
2014-03-28  8:56  7%                     ` Dmitry A. Kazakov
2014-03-20 17:00     Generating an XML DOM tree from scratch withXML/Ada 2013 Marc C
2014-03-21 16:12  5% ` J Kimball
2014-05-02  8:42     Safety of unprotected concurrent operations on constant objects Natasha Kerensikova
2014-05-03 13:43     ` sbelmont700
2014-05-03 20:54       ` Natasha Kerensikova
2014-05-03 21:40         ` Simon Wright
2014-05-04  0:28           ` Jeffrey Carter
2014-05-04  7:46             ` Natasha Kerensikova
2014-05-04 15:18               ` sbelmont700
2014-05-04 15:57                 ` Natasha Kerensikova
2014-05-05 19:04                   ` Brad Moore
2014-05-05 21:23                     ` Brad Moore
2014-05-04 21:44                       ` Shark8
2014-05-05  8:39                         ` Simon Wright
2014-05-05 15:11                           ` Brad Moore
2014-05-05 16:36                             ` Dmitry A. Kazakov
2014-05-06  6:00                               ` Brad Moore
2014-05-06  8:11                                 ` Dmitry A. Kazakov
2014-05-08  4:12                                   ` Brad Moore
2014-05-08  8:20                                     ` Dmitry A. Kazakov
2014-05-09 13:14                                       ` Brad Moore
2014-05-09 19:00                                         ` Dmitry A. Kazakov
2014-05-10 12:30                                           ` Brad Moore
2014-05-10 20:27                                             ` Dmitry A. Kazakov
2014-05-11  6:56  5%                                           ` Brad Moore
2014-07-05 20:32     'Size hack for enumerated types Victor Porton
2014-07-05 21:47     ` Simon Wright
2014-07-05 22:11       ` Victor Porton
2014-07-05 22:18         ` Victor Porton
2014-07-06 20:59           ` Simon Wright
2014-07-06 23:01             ` Victor Porton
2014-07-06 23:30               ` Jeffrey Carter
2014-07-07 16:00                 ` Victor Porton
2014-07-07 17:12                   ` Simon Wright
2014-07-07 20:23                     ` Victor Porton
2014-07-08  7:04                       ` Simon Wright
2014-07-08 14:53                         ` Dan'l Miller
2014-07-08 20:56                           ` Randy Brukardt
2014-07-08 22:26  6%                         ` Dan'l Miller
2014-10-16  3:11     one task missing during the execution compguy45
2014-10-16 14:33     ` Adam Beneschan
2014-10-16 15:31       ` compguy45
2014-10-16 17:48         ` Chris Moore
2014-10-16 21:25  7%       ` compguy45
2014-11-21 11:41     How to get nice with GNAT? Natasha Kerensikova
2014-11-21 12:42  7% ` Björn Lundin
2014-11-22 10:11  7% ` gautier_niouzes
2014-12-15 16:52     Access parameters and accessibility Michael B.
2014-12-16  7:45     ` Randy Brukardt
2014-12-16 19:46       ` Michael B.
2014-12-17  2:02  4%     ` Adam Beneschan
2014-12-17 23:18  0%       ` Randy Brukardt
2015-04-01  8:42  4% I've not seen this error before tonyg
2015-05-30 14:26  6% Arm - ravenscar - exceptions - last chance handler jan.de.kruyf
2015-05-30 15:31     ` Bob Duff
2015-05-30 16:10  6%   ` jan.de.kruyf
2015-05-30 16:50  0%     ` Simon Wright
2015-05-30 20:59  0%       ` jan.de.kruyf
2015-05-30 15:43  0% ` Simon Wright
2015-05-30 16:14  0%   ` jan.de.kruyf
2015-06-04 20:59     Trying to make XMLada use a validating SAX Parser Serge Robyns
2015-06-04 21:47     ` Simon Wright
2015-06-05 15:47  5%   ` Serge Robyns
2015-06-21 18:38     Is there an easier way for this? Laurent
2015-06-21 19:25     ` Jeffrey R. Carter
2015-06-22 16:41       ` Laurent
2015-06-22 16:47         ` Jeffrey R. Carter
2015-06-22 17:18           ` Laurent
2015-06-22 18:04             ` What do you think about this? Laurent
2015-06-23 14:21               ` Stephen Leake
2015-06-23 19:51                 ` Laurent
2015-06-23 20:20                   ` Anh Vo
2015-06-23 21:03                     ` Laurent
2015-06-23 22:17                       ` Shark8
2015-06-24  5:57                         ` Anh Vo
2015-06-24 21:06                           ` Laurent
2015-06-24 21:45                             ` Anh Vo
2015-06-24 22:35                               ` Simon Wright
2015-06-24 22:59                                 ` Laurent
2015-06-25  7:29  5%                               ` Simon Wright
2015-06-25 16:55  0%                                 ` Anh Vo
2015-06-25 18:13  0%                                 ` Laurent
2016-01-06 15:55     Re-write a file in Ada comicfanzine
2016-01-10 16:54     ` comicfanzine
2016-01-11 17:16       ` Brian Drummond
2016-01-18 15:05         ` gautier_niouzes
2016-01-19 12:24           ` Brian Drummond
2016-01-19 16:52  7%         ` gautier_niouzes
2016-01-20  1:39     Out_File , excess line comicfanzine
2016-01-31  8:56     ` comicfanzine
2016-01-31 11:25       ` Simon Wright
2016-01-31 12:57  5%     ` Dmitry A. Kazakov
2016-02-07 22:45  4% ANN: Cortex GNAT RTS 20160207 Simon Wright
2016-02-19 21:02     Asynchronous channels in Ada Hadrien Grasland
2016-02-21 22:57     ` Hadrien Grasland
2016-02-22  8:48  5%   ` Dmitry A. Kazakov
2016-03-14 17:42  4% ANN: Cortex GNAT RTS 20160314 Simon Wright
2016-04-21 10:23  5% timer_server triggers Task_Termination handler Per Dalgas Jakobsen
2016-04-21 12:59  6% Building an encapsulated library that uses GNAT sockets under Windows Dmitry A. Kazakov
2016-04-22  7:58  0% ` ahlan.marriott
2016-04-22  8:23  0%   ` Dmitry A. Kazakov
2016-04-23  9:20  0%     ` Ahlan
2016-05-22 14:20  3% ANN: Cortex GNAT RTS 20160522 Simon Wright
2016-06-01 13:33     fyi, GNAT and SPARK GPL 2016 are out Nasser M. Abbasi
2016-06-04 16:13     ` gautier_niouzes
2016-06-04 16:31       ` Georg Bauhaus
2016-06-04 19:34  3%     ` Simon Wright
2016-06-18 17:05  6% Gtkada: attach signals to menus Stephen Leake
2016-06-18 18:07     ` Dmitry A. Kazakov
2016-06-18 18:21       ` Stephen Leake
2016-06-19 15:02  6%     ` Stephen Leake
2016-07-12 19:50  5% Application Crashes when linked with DLL Aurele
2016-07-19 16:40     Exception traceback when using TDM-GCC 5.1.0-3 ahlan.marriott
2016-07-20  5:33     ` jrmarino
2016-07-20  6:19       ` ahlan
2016-07-20  6:43         ` Simon Wright
2016-07-20  7:13           ` ahlan
2016-07-23 16:13             ` Simon Wright
2016-07-24  8:43               ` ahlan.marriott
2016-07-24  9:44     ` Simon Wright
2016-07-24 17:14       ` jrmarino
2016-07-24 18:54         ` ahlan.marriott
2016-07-24 19:46           ` Björn Lundin
2016-07-25  8:45             ` ahlan.marriott
2016-07-25 12:05               ` Simon Wright
2016-07-25 14:06                 ` Björn Lundin
2016-07-25 18:48                   ` ahlan.marriott
2016-07-26 21:20                     ` jrmarino
2016-07-27  7:35                       ` Simon Wright
2016-07-27 10:57                         ` ahlan.marriott
2016-07-27 13:22                           ` Simon Wright
2016-07-27 14:11                             ` ahlan.marriott
2016-07-27 15:45                               ` Simon Wright
2016-07-27 19:32                                 ` Anh Vo
2016-07-27 20:33                                   ` ahlan.marriott
2016-07-27 21:03                                     ` Anh Vo
2016-07-28  6:07                                       ` ahlan.marriott
2016-07-28  6:56                                         ` ahlan.marriott
2016-07-28 12:26  5%                                       ` Björn Lundin
2016-07-28 16:07  0%                                         ` ahlan.marriott
2016-07-28 16:19  0%                                           ` Björn Lundin
2016-07-28 14:48  6%                                     ` Anh Vo
2016-07-28 15:44  0%                                       ` Anh Vo
2016-07-28 16:00  0%                                         ` ahlan.marriott
2016-07-28 16:16  0%                                           ` Anh Vo
2016-07-28 20:34  0%                                             ` ahlan.marriott
2016-07-29 15:57  0%                                               ` Anh Vo
2016-07-29 18:48  0%                                                 ` Anh Vo
2016-07-30  8:11  0%                                                   ` ahlan.marriott
2016-09-04 19:22     Can anyone help with GNAT.Perfect_Hash_Generators ? (Possible memory corruption) Natasha Kerensikova
2016-09-05 17:18     ` Stephen Leake
2016-09-06 19:24       ` Natasha Kerensikova
2016-09-06 19:52         ` Florian Weimer
2016-09-06 21:04  6%       ` Simon Wright
2016-09-08 16:00  0%         ` Anh Vo
2016-10-12 14:23  5% Gnat Sockets - UDP timeout too short ahlan
2016-11-04  8:48  0% ` ahlan.marriott
2017-01-02 13:21  5% Experimenting with the OOP features in Ada Laurent
2017-01-02 16:41  0% ` Dmitry A. Kazakov
2017-02-23  0:26     State of the compiler market john
2017-02-25 10:48     ` Ingo M.
2017-02-25 11:29       ` Dmitry A. Kazakov
2017-02-25 13:46  5%     ` G.B.
2017-03-23  7:43     Interfaces.C + generics: stack overflow hreba
2017-03-23 20:03     ` Randy Brukardt
2017-03-24 12:42       ` hreba
2017-03-24 22:03  3%     ` Dmitry A. Kazakov
2017-06-08 10:36  6% GNAT.Sockets Streaming inefficiency masterglob
2017-07-07  9:58     Unhandled Exception in Tartan generated code for M68040 Petter Fryklund
2017-07-12 19:30  7% ` Niklas Holsti
2017-08-07  5:48  0%   ` Petter Fryklund
2017-08-07  6:21  5%     ` Niklas Holsti
2017-08-08  5:33  0%       ` Petter Fryklund
2017-08-16 11:04  0%         ` Petter Fryklund
2017-09-16  6:40     NTP Anatoly Chernyshev
2017-09-16  9:29  5% ` NTP Dmitry A. Kazakov
2017-09-21 18:14     Ada.Strings.Unbounded vs Ada.Containers.Indefinite_Holders Victor Porton
2017-09-21 21:30     ` AdaMagica
2017-09-22 12:16       ` Victor Porton
2017-09-22 19:25         ` Simon Wright
2017-09-22 22:15           ` Victor Porton
2017-09-23  8:09             ` Dmitry A. Kazakov
2017-09-23  9:16  5%           ` Jeffrey R. Carter
2017-12-04 11:17     Exception_Occurence and language designers Mehdi Saada
2017-12-04 17:43  6% ` Jeffrey R. Carter
2018-02-16 18:44  6% GNAT user-specified (via Raise_Exception) warning message size limit marciant
2018-02-16 18:59  0% ` Per Sandberg
2018-02-17  0:03  0% ` Randy Brukardt
2018-08-22 13:01  5% GNAT compiler versions and addr2line Phil
2018-08-22 15:14  0% ` Alejandro R. Mosteo
2018-08-22 18:21       ` Phil
2018-08-22 19:43  6%     ` Anh Vo
2018-08-22 20:30  0%       ` Randy Brukardt
2018-10-31  2:57     windows-1251 to utf-8 eduardsapotski
2018-10-31 15:28     ` eduardsapotski
2018-11-01 12:49       ` Björn Lundin
2018-11-01 13:26         ` Dmitry A. Kazakov
2018-11-01 14:34  6%       ` Björn Lundin
2019-02-06 23:10  6% Ada x <whatever> Datagram Sockets Rego, P.
2019-02-16 19:40     How To Create And Use Memory Map Files Michael390@gmail.com
2019-02-17 22:41  6% ` Rego, P.
2019-02-25  6:51     Ada in command / control systems Jesper Quorning
2019-02-25  8:24     ` Dmitry A. Kazakov
2019-02-25 21:18       ` Jesper Quorning
2019-02-26  9:28         ` Maciej Sobczak
2019-02-26 11:01           ` Dmitry A. Kazakov
2019-02-26 21:25             ` Maciej Sobczak
2019-02-27  9:33               ` Dmitry A. Kazakov
2019-02-27 20:46                 ` Maciej Sobczak
2019-02-27 21:55                   ` Dmitry A. Kazakov
2019-02-28 13:12                     ` Maciej Sobczak
2019-02-28 17:43                       ` Dmitry A. Kazakov
2019-03-01  9:22                         ` Maciej Sobczak
2019-03-01 10:46                           ` Dmitry A. Kazakov
2019-03-04  7:03                             ` Maciej Sobczak
2019-03-04 14:38  3%                           ` Dmitry A. Kazakov
2019-11-02 10:22     gtkada evenhandler on_procedure method , how to access children of topwindow in the eventhandler Alain De Vos
2019-11-02 19:07     ` Alain De Vos
2019-11-02 19:21  6%   ` Dmitry A. Kazakov
2019-11-07 22:05  6% hello world ada-ncurses new_window Alain De Vos
2020-01-30  8:55     Last chance handler on a PC ahlan
2020-01-30 19:35  6% ` ahlan
2020-03-23 23:16     GNAT vs Matlab - operation on multidimensional complex matrices darek
2020-06-08 17:42  3% ` Shark8
2020-04-02 13:58     Simple parse from https website Rego, P.
2020-04-02 14:42     ` Dmitry A. Kazakov
2020-04-02 14:48       ` Rego, P.
2020-04-02 17:16  4%     ` Dmitry A. Kazakov
2020-04-02 18:27  0%       ` Rego, P.
2020-04-03 22:48     Proposal: Auto-allocation of Indefinite Objects Stephen Davies
2020-07-27  7:47     ` Yannick Moy
2020-07-27 17:48       ` Brian Drummond
2020-07-27 20:02         ` Dmitry A. Kazakov
2020-07-28 14:28           ` Brian Drummond
2020-07-28 14:59             ` Dmitry A. Kazakov
2020-07-29 15:33               ` Brian Drummond
2020-07-29 16:20                 ` Dmitry A. Kazakov
2020-07-30 17:04                   ` Brian Drummond
2020-07-30 18:28                     ` Dmitry A. Kazakov
2020-08-10  0:39                       ` Randy Brukardt
2020-08-10  8:57                         ` Dmitry A. Kazakov
2020-08-20  0:10                           ` Randy Brukardt
2020-08-20 17:49                             ` Dmitry A. Kazakov
2020-08-20 23:30  5%                           ` Randy Brukardt
2020-04-29  8:46     Getting the 3 letter time zone abbreviation Bob Goddard
2020-04-29  9:09     ` Dmitry A. Kazakov
2020-04-29 19:20       ` Bob Goddard
2020-04-29 19:53         ` Dmitry A. Kazakov
2020-04-30 18:59           ` Bob Goddard
2020-04-30 21:11  5%         ` Dmitry A. Kazakov
2020-06-06 23:40  4% CONSTRAINT ERROR: erroneous memory access jcupak
2020-06-07 15:53  0% ` Anh Vo
2020-09-11 10:37     Visibility issue Daniel
2020-09-17 21:47  4% ` Shark8
2021-01-05 11:04     Lower bounds of Strings Stephen Davies
2021-01-06  3:08     ` Randy Brukardt
2021-01-06  9:13       ` Dmitry A. Kazakov
2021-01-07  0:17  3%     ` Randy Brukardt
     [not found]     <602e608e$0$27680$e4fe514c@news.kpn.nl>
2021-02-25 12:43     ` Alternative for Gnat Studio ldries46
2021-02-25 18:10  5%   ` Simon Wright
2021-04-17 22:03     Ada and Unicode DrPi
2021-04-19  9:08     ` Stephen Leake
2021-04-19 11:56       ` Luke A. Guest
2021-04-19 12:52         ` Dmitry A. Kazakov
2021-04-19 13:00           ` Luke A. Guest
2021-04-20 19:06             ` Randy Brukardt
2022-04-03 18:37               ` Thomas
2022-04-04 23:52  3%             ` Randy Brukardt
2023-03-31  3:06  0%               ` Thomas
2023-04-01 10:18  0%                 ` Randy Brukardt
     [not found]     <nnd$672ea4c3$361caa01@549d065034cf3e10>
2021-09-21  6:49  5% ` Exception Handling within Gtkada Vadim Godunko
2021-09-21  7:01  0%   ` Dmitry A. Kazakov
2021-09-21  7:24  0%     ` Emmanuel Briot
2021-09-21  7:40  0%       ` Dmitry A. Kazakov
2021-09-22  8:42  0%     ` ldries46
2021-09-22 10:22  0%       ` Dmitry A. Kazakov
2022-06-06 12:59     Extra information in the message string of exceptions Rod Kay
2022-06-06 20:49     ` DrPi
2022-06-06 23:17  7%   ` Jerry
2022-08-17 20:11  5% Adjust primitive not called on defaulted nonlimited controlled parameter, bug or feature ? David SAUVAGE
2022-08-17 22:49  0% ` Jere
2022-09-11  7:16  4% Is this an error in compiler? reinert
2022-09-11  7:19  4% Is this an error in compiler reinert
2022-09-11  7:21  4% Is this an error in compiler? reinert
2022-09-11  7:27  4% reinert
2022-09-24  7:52     MS going to rust (and Linux too) Dmitry A. Kazakov
2022-09-24  8:50     ` Luke A. Guest
2022-09-24  9:13       ` Dmitry A. Kazakov
2022-09-24 11:41         ` G.B.
2022-09-24 13:05           ` Luke A. Guest
2022-09-24 17:49  4%         ` G.B.
2022-10-23  4:36  5% Exceptions Not Working Under High Sierra Roger Mc
2022-10-23  6:33  0% ` Simon Wright
2022-10-23 10:57  0%   ` Roger Mc
2023-01-22 21:34     Real_Arrays on heap with overloaded operators and clean syntax Jim Paloander
2023-01-22 23:18     ` Rod Kay
2023-01-22 23:20       ` Jim Paloander
2023-01-22 23:34         ` Rod Kay
2023-01-22 23:53  4%       ` Joakim Strandberg
2023-06-30 19:28     GNAT Community 2020 (20200818-93): Big_Integer Frank Jørgen Jørgensen
2023-06-30 21:07  5% ` Dmitry A. Kazakov

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox