Re: How to get nice with GNAT?

[brbarkstrom@gmail.com]

On Sunday, November 23, 2014 3:49:38 PM UTC-5, Jeffrey Carter wrote:
> On 11/23/2014 10:41 AM, brbarkstrom wrote:
> > 
> > I'm working in GNAT GPL, so my suggestion may not work with every
> > compiler.
> > 
> > On the other hand, in my code, the if following the exception in the
> > procedure is picked up and executed properly.  The code doesn't act
> > like the program has to fail if any exception is raised.
> 
> I don't think you're talking about exceptions. I took this program:
> 
> with Ada.Text_IO;
> procedure Boolean_Exception is
>    procedure Test (OK : out Boolean) is
>       -- empty declarative part
>    begin -- Test
>       OK := False;
> 
>       raise Constraint_Error;
>    end Test;
> 
>    OK : Boolean := True;
> begin -- Boolean_Exception
>    Test (OK => OK);
>    Ada.Text_IO.Put_Line (Item => "No exception");
> exception -- Boolean_Exception
> when others =>
>    Ada.Text_IO.Put_Line (Item => Boolean'Image (OK) );
> end Boolean_Exception;
> 
> compiled with GNAT 4.6 on Linux, and got:
> 
> $ gnatmake -gnatwa -gnatano -O2 -fstack-check boolean_exception.adb
> gcc-4.6 -c -gnatwa -gnatano -O2 -fstack-check boolean_exception.adb
> boolean_exception.adb:6:10: warning: assignment to pass-by-copy formal may have
> no effect
> boolean_exception.adb:6:10: warning: "raise" statement may result in abnormal
> return (RM 6.4.1(17))
> gnatbind -x boolean_exception.ali
> gnatlink boolean_exception.ali -O2 -fstack-check
> $ ./boolean_exception
> TRUE
> 
> What you're talking about doesn't work with GNAT.
> 
> -- 
> Jeff Carter
> "This school was here before you came,
> and it'll be here before you go."
> Horse Feathers
> 48

Here's a rather long response to your post:

I don't think you'll get a sensible response when you try to set
Test(OK => True); or Test(OK => False) when the specification of
the procedure Test has OK as an "out" variable.  It doesn't make 
sense try to set this value as input to a variable that emerges from the procedure (Test).

Here's a slight rewriting of the code you provided:

with Ada.Text_IO;
procedure exception_handling_0 is

   procedure test (OK : out Boolean) is
      -- empty declarative part
   begin -- test
      OK := False;
      raise Constraint_Error;
   end test;

   OK : Boolean := True;

begin -- exception_handling_0
   test (OK => OK);
   Ada.Text_IO.Put_Line (Item => "No exception");

exception
   when others =>
      Ada.Text_IO.Put_Line (Item => Boolean'Image (OK) );
end exception_handling_0;

The GNAT GPL GPS tool on my Ubuntu 14.04 LTS system returns the
two warnings:
7.10     warning: assignment to pass-by-copy formal may have no effect
7.10     warning: "raise" statement may result in abnormal return
           (RM 6.4.1(17))

In other words, a programmer shouldn't expect a variable input to
an "out" variable in the interface specification to have any relation
to whatever is generated in the procedure that is called.  Secondly,
an exception raised in the procedure test may result in an abnormal
return.  This is hardly a clean piece of code. 

When I run it, the output from the code does something that seems
to me to be an abnormal return.  It returns the output "TRUE".
The output claims that "the process terminated successfully, ...".  
It certainly isn't the expected behavior in a reasonable reading of the 
procedure text.  Rather it suggests that the compiler completely ignored
whatever went on in the procedure.

Putting the same code into a Windows XP installation of GNAT GPL 2014 with GPS
produces exactly the same warnings, compilation, and output.

In the original source code I provided, I used the following specification
file (called Common_Defs.ads):

with Ada.Characters.Latin_1;
with Ada.Strings;
with Ada.Strings.Bounded;
with Ada.Numerics;
with Ada.Numerics.generic_elementary_functions;

package Common_Defs is
  ------------------------------------------------------------------------------
  -- Generic Packages
  ------------------------------------------------------------------------------
  subtype real        is long_float;
  package Usr_Math    is new
                        Ada.Numerics.generic_elementary_functions(real);
  Std_Vstring_Length  : constant :=  256;
  package VString     is new
                        Ada.Strings.Bounded.Generic_Bounded_Length(Std_Vstring_Length);
  Long_Vstring_Lngth  : constant := 5000;
  package Long_Vstring is new
                        Ada.Strings.Bounded.Generic_Bounded_Length(Long_Vstring_Lngth);
  ------------------------------------------------------------------------------
  -- Constant
  ------------------------------------------------------------------------------
   TAB                         : constant Character := Ada.Characters.Latin_1.HT;
end Common_Defs;

Then, I created the source code

with Ada.Text_IO;
with Common_Defs; use Common_Defs;
procedure Test_Exception is

   -- Local Procedure Specification
   procedure Test (I       : in     Natural;
                   OK      :    out Boolean;
                   Err_Msg :    out Vstring.Bounded_String);

   -- Variables
   I       : Natural := 20;
   Test_OK : Boolean;
   Err_Msg : Vstring.Bounded_String;

   -- Local Procedure Body
   procedure Test (I       : in     Natural;
                   OK      :    out Boolean;
                   Err_Msg :    out Vstring.Bounded_String) is
      Max_I          : Natural := 10;
      I_Out_Of_Range : exception;      
   begin -- Test
      OK := False;
      Err_Msg := Vstring.To_Bounded_String("procedure Test was not initialized when this message was created.");
      if I <= Max_I then
         OK := True;
         Err_Msg := Vstring.To_Bounded_String("In procedure Test, I as input : ");
         Err_Msg := Vstring.Append(Err_Msg, Natural'image(I));
         Err_Msg := Vstring.Append(Err_Msg, " was less than or equal to ");
         Err_Msg := Vstring.Append(Err_Msg, Natural'image(Max_I));
      else
         raise I_Out_Of_Range;
      end if;
   exception
      when I_Out_Of_Range =>
         Err_Msg := Vstring.To_Bounded_String("In procedure Test, I as input : ");
         Err_Msg := Vstring.Append(Err_Msg, Natural'image(I));
         Err_Msg := Vstring.Append(Err_Msg, " was greater than ");
         Err_Msg := Vstring.Append(Err_Msg, Natural'image(Max_I));
         Err_Msg := Vstring.Append(Err_Msg, " which raises the constraint 'I_Out_Of_Range'.");
      when others =>
         Err_Msg := Vstring.To_Bounded_String("In procedure Test, something unexpected happened.");
   end Test;

begin -- Test_Exception
   Test (I       => 25,
         OK      => Test_OK,
         Err_Msg => Err_Msg);
   if Test_OK then
      Ada.Text_IO.Put_Line(Vstring.To_String(Err_Msg));
   else
      Ada.Text_IO.Put_Line(Vstring.To_String(Err_Msg));
   end if;
end Test_Exception; 

On Windows, this compiles without warnings.  After compilation, binding, and linking, it
runs and outputs the message 
"In procedure Test, I as input :  25 was greater than  10 which raises the constraint 'I_Out_Of_Range'."  It is clear that the initial setting of
OK and Err_Msg in the procedure have been changed as a result of the
operations during execution.

The behavior on the Ubuntu Linux 64-bit installation of GNAT GPL is identical.

My conclusions:

1.  One should not call a procedure to input an "out" variable as declared in the spec and
expect it to return values from the interior of the procedure.  In this code, the exception is not one of the system exceptions.
Rather, it is one declared normally in accord with the RM (11.1).  An exception handler follows the
specification in RM (11.2), where the Examples at the end of this definition show an approach
that the code I've provided follows.

2.  The handled sequence of statements allow variables set as "out" in the procedure specification
to appear as legitimate values (even using the "pass-by-copy" rule).  Thus, these "out" variables
can guide procedure actions for the calling procedure even when the called
procedure throws an exception.

Bruce B.