From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00,INVALID_MSGID
	autolearn=no autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,b587faeee5fad895,start
X-Google-Attributes: gid103376,public
From: Al Johnston <sofeise@mindspring.com>
Subject: ada/c if - putenv?
Date: 2000/03/07
Message-ID: <38C53194.EE4BAC3E@mindspring.com>#1/1
X-Deja-AN: 594316855
Content-Transfer-Encoding: 7bit
Organization: MindSpring Enterprises
X-Accept-Language: en
X-Server-Date: 7 Mar 2000 16:44:36 GMT
Content-Type: text/plain; charset=us-ascii
Mime-Version: 1.0
Newsgroups: comp.lang.ada
Date: 2000-03-07T16:44:36+00:00
List-Id: <comp.lang.ada>

I am try to learn ada->c interfacing.

Will someone please explain why the following program does not
work?.  If I set the env manually and remove the call to putenv
from the test case, the call to getenv works okay... but when
I let the test code call putenv, not only does the getenv call
not return the value given it by the putenv call, but it does
not even get the old (manually set) value...

what am I missing (gnat 3.12 on a linux RH6.1 x86)

tnx,

-al

with euanos;
with text_io;

procedure test is
begin
  euanos.PutEnv("ASJ=hi");
  text_io.put_line(" ==>" & euanos.GetEnv("ASJ") & "<==");
end test;

with interfaces.c.strings;

package EUANOS  is

  --
---------------------------------------------------------------------------

  -- Name: EUANOS (eise-utilities/ada/native/op-system
  --
  --
---------------------------------------------------------------------------

  EUANOS_PutEnv_Failed : exception;


  procedure PutEnv(Sym : String);


  function GetEnv(Sym : String) return String;

end EUANOS;

with interfaces.c.strings;

package body EUANOS is

  --
---------------------------------------------------------------------------

  -- Name: EUANOS (eise utilities/ada/native/op-system
  --
  --
---------------------------------------------------------------------------

  package EUANOS_CIf is

    --
-------------------------------------------------------------------------

    -- see man putenv(3V)
    --
    -- int putenv(const char *string);
    --
    function putenv(Sym : interfaces.c.strings.Chars_Ptr)
             return interfaces.c.Int;
    pragma import(c,putenv,"putenv");
    --
-------------------------------------------------------------------------



    --
-------------------------------------------------------------------------

    -- see man getenv(3V)
    --
    -- char *getenv(const char *name);
    --
    function getenv(sym : interfaces.c.strings.Chars_Ptr)
             return interfaces.c.strings.Chars_Ptr;
    pragma import(c,getenv,"getenv");
    --
-------------------------------------------------------------------------

  end EUANOS_CIf;


  procedure PutEnv(Sym : String) is
    Arg    : interfaces.c.strings.Chars_Ptr;
    Result : interfaces.c.Int;
  begin
    Arg    := interfaces.c.strings.New_String(Sym);
    Result := EUANOS_CIf.putenv(Arg);
    interfaces.c.strings.Free(Arg);
    if (integer(Result) /= 0) then
      raise EUANOS_PutEnv_Failed;
    end if;
  end PutEnv;

  function GetEnv(Sym : String) return String is
    Arg    : interfaces.c.strings.Chars_Ptr;
    Result : interfaces.c.strings.Chars_Ptr;
  begin
    Arg    := interfaces.c.strings.New_String(Sym);
    Result := EUANOS_CIf.getenv(Arg);
    interfaces.c.strings.Free(Arg);
    if interfaces.c.strings."="(Result,interfaces.c.strings.Null_Ptr)
then
      return "-";
    else
      return interfaces.c.strings.Value(Result);
    end if;
  end GetEnv;

end EUANOS;