Out parameter in function, used in Distributed (PolyORB) application GNAT 2014 / Windows 8.1

[dontspam365@gmail.com]

Hi!
I have some experiences with the attached code that I don't quite understand.
I am running this on GNAT 2014 / Windows 8.1


I compiled the attached example with PolyORB installed, by using: po_gnatdist test_conf.cfg
Open two Command Prompt windows.
In one of them perform:    set POLYORB_DSA_NAME_SERVICE=corbaloc:iiop:1.2@???.???.???.???:2809/_NameService
Replacing "???.???.???.???" with IP address of your test computer.
Make sure that the line in polyorb.conf is configured on the following property: polyorb.protocols.iiop.default_addr=???.???.???.???3:2809
in the same way as above.


Compile the code as attached.
In one Command Prompt execute:       a_client.exe
In the other Command Prompt execute: test_server.exe

Result:
The call to ServerRCI.Get_Value_Function   returns Status=A (I expect B)
The call to ServerRCI.Get_Value_Procedure  returns Status=B (As I expect)


I get the feeling there is something "not-intuitive" going on with the out parameter in the function in this Distributed case.
I have not identified any exceptions begin raised.



---------
with ServerRCI;
with Text_IO;

procedure Test_Main
is
  Ret1, Ret2 : ServerRCI.Type_Adm_Status;
  Res : ServerRCI.Type_Id;
begin

  Res := ServerRCI.Get_Value_Function ("Something", Ret1 );
  Text_IO.Put_Line("Function:Res =" & Res'Img & " Status=" & Ret1'Img);

  ServerRCI.Get_Value_Procedure ("Something", Ret2, Res );
  Text_IO.Put_Line("Procedure:Res =" & Res'Img & " Status=" & Ret2'Img);

end Test_Main;
---------
with ServerRCI;
with Text_IO;

procedure Test_Server_Starter is

run : Boolean := True;
begin
  ServerRCI.Start;


  delay 1.5;
  Text_IO.Put_Line("Stop");
  ServerRCI.Stop;
end Test_Server_Starter;
----------

package ServerRCI is
   pragma Remote_Call_Interface;
   type Type_Id is range 0 .. 99;
   type Type_Adm_Status is (A,
                            B,
                            C,
                            D,
                            E,
                            F,
                            G,
                            H,
                           I);

   procedure Start;
   procedure Stop;

   function Get_Value_Function
     (P_Text : in String;
      P_Status      : out Type_Adm_Status)
      return          Type_Id;

   procedure Get_Value_Procedure
     (P_Text   : in String;
      P_Status : out Type_Adm_Status;
      P_Id     :  out Type_Id);

end ServerRCI;
--------------

with Text_IO;

package body ServerRCI is



  task type Type_A_Task is
    entry Start;
    entry Get_Value_Entry (P_Text : in String;
                     P_Status      : out Type_Adm_Status;
                     P_Id   : out Type_Id);
    entry Stop;
  end Type_A_Task;

  task  body Type_A_Task is
    Run : Boolean := True;
  begin
    accept Start;
    while Run loop
      select
        accept Stop do
          Run := False;
        end Stop;
      or
        accept Get_Value_Entry (P_Text  : in String;
                          P_Status      : out Type_Adm_Status;
                          P_Id          : out Type_Id) do

          P_Id := Type_Id(1);
          P_Status := A;
          P_Status := B;
          Text_IO.Put_Line("P_Status=" & P_Status'Img );
        end Get_Value_Entry;
      else
        null;
      end select;

    end loop;
  end Type_A_Task;

  A_Task : Type_A_Task;
  
  procedure Start is
  begin
    A_Task.Start;
  end Start;

   function Get_Value_Function
     (P_Text : in String;
      P_Status       : out Type_Adm_Status)
      return          Type_Id
   is
      Id : Type_Id;

   begin
   
     A_Task.Get_Value_Entry(P_Text, P_Status, Id);

     return Id;
   end Get_Value_Function;


   procedure Get_Value_Procedure
     (P_Text   : in String;
      P_Status : out Type_Adm_Status;
      P_Id     :  out Type_Id)
   is

   begin
   
     A_Task.Get_Value_Entry(P_Text, P_Status, P_Id);

   end Get_Value_Procedure;

   procedure Stop is
   begin
     A_Task.Stop;
   end Stop;

end ServerRCI;
-------------------

configuration test_conf is

   pragma Version (False);
   pragma Starter (None);

   pragma Name_Server (Embedded);


   a_client : Partition := (Test_Main);

   procedure Test_Main;
   for a_client'Main use Test_Main;


   test_server : Partition := (ServerRCI);
   procedure test_server_starter is in test_server;


   for test_server'Host use "localhost";
   for test_server'Termination use Local_Termination;

end test_conf;
------------------------