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=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI autolearn=unavailable autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,dc6c08034f612943,start X-Google-Attributes: gid103376,public X-Google-ArrivalTime: 2000-11-19 21:39:18 PST Path: supernews.google.com!sn-xit-02!sn-xit-03!supernews.com!xfer13.netnews.com!netnews.com!fr.clara.net!heighliner.fr.clara.net!proxad.net!teaser.fr!enst!enst.fr!not-for-mail From: Christoph Grein Newsgroups: comp.lang.ada Subject: Win32.Commdlg.GetOpenFileName problem - Gnat bug? Date: Mon, 20 Nov 2000 06:36:03 +0100 (MET) Organization: ENST, France Message-ID: <200011200536.GAA05340@bulgaria.otn.eurocopter.de> Reply-To: comp.lang.ada@ada.eu.org NNTP-Posting-Host: marvin.enst.fr Mime-Version: 1.0 Content-Type: TEXT/plain; charset=us-ascii X-Trace: menuisier.enst.fr 974698702 31982 137.194.161.2 (20 Nov 2000 05:38:22 GMT) X-Complaints-To: usenet@enst.fr NNTP-Posting-Date: 20 Nov 2000 05:38:22 GMT Cc: Christ-Usch.Grein@t-online.de To: comp.lang.ada@ada.eu.org Return-Path: Content-MD5: kqCHKxHLM1uxfDDclVGpYA== X-Mailer: dtmail 1.2.1 CDE Version 1.2.1 SunOS 5.6 sun4u sparc Errors-To: comp.lang.ada-admin@ada.eu.org X-BeenThere: comp.lang.ada@ada.eu.org X-Mailman-Version: 2.0beta5 Precedence: bulk List-Id: comp.lang.ada mail<->news gateway Errors-To: comp.lang.ada-admin@ada.eu.org X-BeenThere: comp.lang.ada@ada.eu.org Xref: supernews.google.com comp.lang.ada:2255 Date: 2000-11-20T05:38:22+00:00 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;