Win32.Commdlg.GetOpenFileName problem - Gnat bug?

[Christoph Grein <christoph.grein@eurocopter.de>]

Hi everyone listening,

I'm having a problem on Win98 with Gnat 3.13.p. I wrote the following
package following an example in AdaPower. Function Get_File_Name opens the 
wellknown Open window where to select a file.

Now if I use the function call as a constant (see procedure Test_Gnat_Bug),
everything works, but if I use it as a renames, it produces empty output.
(In Ada95, function calls are objects, which are renamable; in Ada83, they
were not. Renaming saves an extra copy.)

Is this a gnat bug or an inherent win32 feature? I have been struggling with
funny effects for a while, until I found the reason by pure coincidence.

gnatchop here
-----------------------------------------------------------------------------
with Ada.Strings.Unbounded;

package Gnat_Bug is

  subtype Unbounded_String is Ada.Strings.Unbounded.Unbounded_String;

  function To_Unbounded_String (Item: String) return Unbounded_String
    renames Ada.Strings.Unbounded.To_Unbounded_String;
  function To_String (Item: Unbounded_String) return String
    renames Ada.Strings.Unbounded.To_String;

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

  type File_Name is record
    Extended, Simple: Unbounded_String;  -- with and without path
  end record;

  type Filter_Definition is record
    Name, Pattern: Unbounded_String;
  end record;

  type Filter is array (Positive range <>) of Filter_Definition;

  All_Files_Filter: constant Filter_Definition :=
      (To_Unbounded_String ("All files"),
       To_Unbounded_String ("*.*"));

  Default_Filter: constant Filter := (1 => All_Files_Filter);

  function Get_File_Name (Purpose          : String;
                          Selectable_Files : Filter  := Default_Filter;
                          Default_Selection: Natural := 0;
                          Default_Extension: String  := "";
                          Initial_Directory: String  := "")
                         return File_Name;

  Failure: exception;

end Gnat_Bug;
with Ada.Characters.Latin_1;
with Ada.Unchecked_Conversion;

with System;

with Interfaces.C;
use  Interfaces.C;

with Win32.Commdlg, Win32.WinMain;

package body Gnat_Bug is

  function To_LPSTR  is
     new Ada.Unchecked_Conversion (System.Address, Win32.LPSTR);
  function To_LPCSTR is
     new Ada.Unchecked_Conversion (System.Address, Win32.LPCSTR);

  use type Win32.BOOL;

  function To_WinFilter (Given: Filter) return Char_Array is
    -- To define a filter for the file names use:
    --   {Name & nul & Pattern & nul &} & nul & nul
    Result: Unbounded_String;
    NUL: Character renames Ada.Characters.Latin_1.NUL;
    use type Ada.Strings.Unbounded.Unbounded_String;
  begin
    for F in Given'Range loop
      Result := Result & Given (F).Name & NUL & Given (F).Pattern & NUL;
    end loop;
    return To_C (To_String (Result) & NUL & NUL);
  end To_WinFilter;

  function Get_File_Name (Purpose          : String;
                          Selectable_Files : Filter  := Default_Filter;
                          Default_Selection: Natural := 0;
                          Default_Extension: String  := "";
                          Initial_Directory: String  := "")
                         return File_Name is

    tmpOpenFileStruc: aliased  Win32.Commdlg.OPENFILENAME;
    szFile          :          Char_Array (0..255) := (others => nul);
    szFileTitle     :          Char_Array (0..255) := (others => nul);
    szTitle         : constant Char_Array          := To_C (Purpose);
    szFilter        : constant Char_Array          :=
                        To_WinFilter (Selectable_Files);
    szDefExt        : constant Char_Array          := To_C (Default_Extension);
    szDirectory     : constant Char_Array          := To_C (Initial_Directory);

    Default: Positive;

    Result: Win32.BOOL;

  begin

    if Default_Selection in Selectable_Files'Range then
      Default := Default_Selection;
    elsif Default_Selection = 0 then
      Default := Selectable_Files'First;
    else
      Default := Selectable_Files'Last;
    end if;

    tmpOpenFileStruc.lStructSize       := (Win32.Commdlg.OPENFILENAME'Size + 1)/
                                             System.Storage_Unit;
    tmpOpenFileStruc.hwndOwner         := System.Null_Address;
    tmpOpenFileStruc.hInstance         := Win32.WinMain.Get_Hinstance;
    tmpOpenFileStruc.lpstrFilter       := To_LPCSTR (szFilter'Address);
    tmpOpenFileStruc.lpstrCustomFilter := null;
    tmpOpenFileStruc.nMaxCustFilter    := 0;
    tmpOpenFileStruc.nFilterIndex      := Integer'Pos (Default);
    tmpOpenFileStruc.lpstrFile         := To_LPSTR (szFile'Address);
    tmpOpenFileStruc.nMaxFile          := szFile'Length;
    tmpOpenFileStruc.lpstrFileTitle    := To_LPSTR (szFileTitle'Address);
    tmpOpenFileStruc.nMaxFileTitle     := szFileTitle'Length;
    tmpOpenFileStruc.lpstrInitialDir   := To_LPCSTR (szDirectory'Address);
    tmpOpenFileStruc.lpstrTitle        := To_LPCSTR (szTitle'Address);
    tmpOpenFileStruc.nFileOffset       := 0;
    tmpOpenFileStruc.nFileExtension    := 0;
    tmpOpenFileStruc.lpstrDefExt       := To_LPCSTR (szDefExt'Address);
    tmpOpenFileStruc.lCustData         := 0;
    tmpOpenFileStruc.lpfnHook          := null;
    tmpOpenFileStruc.lpTemplateName    := null;
    tmpOpenFileStruc.Flags             := 0;

    Result := Win32.Commdlg.GetOpenFileName (tmpOpenFileStruc'Unchecked_Access);

    if Result = Win32.False then
      raise Failure;
      -- Use the API call CommDlgExtendedError for more information.
    end if;

    return (Extended => To_Unbounded_String (To_Ada (szFile)),
            Simple   => To_Unbounded_String (To_Ada (szFileTitle)));

  end Get_File_Name;

end Gnat_Bug;
with Ada.Text_IO;
use  Ada.Text_IO;

with Gnat_Bug;
use  Gnat_Bug;

procedure Test_Gnat_Bug is

begin

  declare  -- this works, i.e. prints the file
    File_Name: constant Gnat_Bug.File_Name :=
             Get_File_Name (Purpose           => "Open test with constant",
                            Default_Selection => 4);
  begin
    Put_Line ("Open selection extended name => " &
              To_String (File_Name.Extended));
    Put_Line ("               simple name   => " &
              To_String (File_Name.Simple));
  exception
    when Failure => Put_Line ("Open Failure");
  end;

  declare  -- this does not work, i.e. produces an empty output
    File_Name: Gnat_Bug.File_Name renames
               Get_File_Name (Purpose           => "Open test with renames",
                              Default_Selection => 4);
  begin
    Put_Line ("Open selection extended name => " &
              To_String (File_Name.Extended));
    Put_Line ("               simple name   => " &
              To_String (File_Name.Simple));
  exception
    when Failure => Put_Line ("Open Failure");
  end;

end Test_Gnat_Bug;