From d7598e110d060f8b7fb6598736f68700b20c400f Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 2 May 2007 08:43:30 +0000 Subject: re PR ada/29856 (broken if..else in gcc/ada/adaint.c) 2007-04-20 Pascal Obry * gnatchop.adb (Write_Source_Reference_Pragma): Change implementation to use Stream_IO.File_Type. This is needed to make use of the UTF-8 encoding support of Stream_IO. (Write_Unit): Idem. * adaint.h, adaint.c (__gnat_os_filename): New routine. Returns the filename and corresponding encoding to match the OS requirement. (__gnat_file_exists): Do not call __gnat_stat() on Windows as this routine will fail on specific devices like CON: AUX: ... PR ada/29856: Add missing braces From-SVN: r124347 --- gcc/ada/ChangeLog | 14 ++++ gcc/ada/adaint.c | 37 ++++++++++- gcc/ada/adaint.h | 21 +++--- gcc/ada/gnatchop.adb | 184 +++++++++++++++++++++++++++++++-------------------- 4 files changed, 173 insertions(+), 83 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ef55b79..e85a5a0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2007-05-02 Pascal Obry + + * gnatchop.adb (Write_Source_Reference_Pragma): Change implementation + to use Stream_IO.File_Type. This is needed to make use of the UTF-8 + encoding support of Stream_IO. + (Write_Unit): Idem. + + * adaint.h, adaint.c (__gnat_os_filename): New routine. Returns the + filename and corresponding encoding to match the OS requirement. + (__gnat_file_exists): Do not call __gnat_stat() on Windows as this + routine will fail on specific devices like CON: AUX: ... + + PR ada/29856: Add missing braces + 2007-04-22 Andrew Pinski PR ada/31660 diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 9952bc8..ff2d0a4 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2006, Free Software Foundation, Inc. * + * Copyright (C) 1992-2007, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -619,6 +619,25 @@ __gnat_get_debuggable_suffix_ptr (int *len, const char **value) return; } +/* Returns the OS filename and corresponding encoding. */ + +void +__gnat_os_filename (char *filename, char *w_filename, + char *os_name, int *o_length, + char *encoding, int *e_length) +{ +#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) + WS2SU (os_name, (TCHAR *)w_filename, o_length); + *o_length = strlen (os_name); + strcpy (encoding, "encoding=utf8"); + *e_length = strlen (encoding); +#else + strcpy (os_name, filename); + *o_length = strlen (filename); + *e_length = 0; +#endif +} + FILE * __gnat_fopen (char *path, char *mode, int encoding) { @@ -991,8 +1010,10 @@ __gnat_readdir (DIR *dirp, char *buffer, int *len) #elif defined (HAVE_READDIR_R) /* If possible, try to use the thread-safe version. */ if (readdir_r (dirp, buffer) != NULL) - *len = strlen (((struct dirent*) buffer)->d_name); - return ((struct dirent*) buffer)->d_name; + { + *len = strlen (((struct dirent*) buffer)->d_name); + return ((struct dirent*) buffer)->d_name; + } else return NULL; @@ -1513,9 +1534,19 @@ __gnat_stat (char *name, struct stat *statbuf) int __gnat_file_exists (char *name) { +#ifdef __MINGW32__ + /* On Windows do not use __gnat_stat() because a bug in Microsoft + _stat() routine. When the system time-zone is set with a negative + offset the _stat() routine fails on specific files like CON: */ + TCHAR wname [GNAT_MAX_PATH_LEN + 2]; + + S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2); + return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES; +#else struct stat statbuf; return !__gnat_stat (name, &statbuf); +#endif } int diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h index 6fbb93d..131fe1f 100644 --- a/gcc/ada/adaint.h +++ b/gcc/ada/adaint.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2006, Free Software Foundation, Inc. * + * Copyright (C) 1992-2007, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -47,10 +47,9 @@ typedef long OS_Time; /* Type corresponding to GNAT.OS_Lib.OS_Time */ extern int __gnat_max_path_len; extern OS_Time __gnat_current_time (void); -extern void __gnat_to_gm_time (OS_Time *, int *, - int *, int *, - int *, int *, - int *); +extern void __gnat_to_gm_time (OS_Time *, int *, int *, + int *, int *, + int *, int *); extern int __gnat_get_maximum_file_name_length (void); extern int __gnat_get_switches_case_sensitive (void); extern int __gnat_get_file_names_case_sensitive (void); @@ -72,7 +71,8 @@ extern int __gnat_mkdir (char *); extern int __gnat_stat (char *, struct stat *); extern FILE *__gnat_fopen (char *, char *, int); -extern FILE *__gnat_freopen (char *, char *, FILE *, int); +extern FILE *__gnat_freopen (char *, char *, FILE *, + int); extern int __gnat_open_read (char *, int); extern int __gnat_open_rw (char *, int); extern int __gnat_open_create (char *, int); @@ -165,6 +165,9 @@ extern int __gnat_set_close_on_exec (int, int); extern int __gnat_dup (int); extern int __gnat_dup2 (int, int); +extern void __gnat_os_filename (char *, char *, char *, + int *, char *, int *); + #ifdef __MINGW32__ extern void __gnat_plist_init (void); #endif @@ -175,7 +178,7 @@ extern void __gnat_plist_init (void); #endif /* This function returns the version of GCC being used. Here it's GCC 3. */ -extern int get_gcc_version (void); +extern int get_gcc_version (void); -extern int __gnat_binder_supports_auto_init (void); -extern int __gnat_sals_init_using_constructors (void); +extern int __gnat_binder_supports_auto_init (void); +extern int __gnat_sals_init_using_constructors (void); diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 086548c..713e830 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2006, AdaCore -- +-- Copyright (C) 1998-2007, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -24,19 +24,21 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Text_IO; use Ada.Text_IO; +with Ada.Characters.Conversions; use Ada.Characters.Conversions; +with Ada.Command_Line; use Ada.Command_Line; +with Ada.Directories; use Ada.Directories; +with Ada.Streams.Stream_IO; use Ada.Streams; +with Ada.Text_IO; use Ada.Text_IO; +with System.CRTL; use System; use System.CRTL; -with GNAT.Command_Line; use GNAT.Command_Line; -with GNAT.OS_Lib; use GNAT.OS_Lib; +with GNAT.Command_Line; use GNAT.Command_Line; +with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.Heap_Sort_G; with GNAT.Table; with Gnatvsn; with Hostparm; -with System.CRTL; use System.CRTL; - procedure Gnatchop is Terminate_Program : exception; @@ -155,7 +157,6 @@ procedure Gnatchop is Bufferg : String_Access; -- Pointer to buffer containing configuration pragmas to be -- prepended. Null if no pragmas to be prepended. - end record; -- The following table stores the unit offset information @@ -227,8 +228,7 @@ procedure Gnatchop is function Locate_Executable (Program_Name : String; - Look_For_Prefix : Boolean := True) - return String_Access; + Look_For_Prefix : Boolean := True) return String_Access; -- Locate executable for given program name. This takes into account -- the target-prefix of the current command, if Look_For_Prefix is True. @@ -241,8 +241,7 @@ procedure Gnatchop is function Get_EOL (Source : not null access String; - Start : Positive) - return EOL_String; + Start : Positive) return EOL_String; -- Return the line terminator used in the passed string procedure Parse_EOL @@ -307,8 +306,7 @@ procedure Gnatchop is function Get_Config_Pragmas (Input : File_Num; - U : Unit_Num) - return String_Access; + U : Unit_Num) return String_Access; -- Call to read configuration pragmas from given unit entry, and -- return a buffer containing the pragmas to be appended to -- following units. Input is the file number for the chop file and @@ -317,7 +315,7 @@ procedure Gnatchop is procedure Write_Source_Reference_Pragma (Info : Unit_Info; Line : Line_Num; - FD : File_Descriptor; + File : Stream_IO.File_Type; EOL : EOL_String; Success : in out Boolean); -- If Success is True on entry, writes a source reference pragma using @@ -338,7 +336,7 @@ procedure Gnatchop is -- dup -- --------- - function dup (handle : File_Descriptor) return File_Descriptor is + function dup (handle : File_Descriptor) return File_Descriptor is begin return File_Descriptor (System.CRTL.dup (int (handle))); end dup; @@ -1461,7 +1459,6 @@ procedure Gnatchop is Close (FD); return Success; - end Write_Chopped_Files; ----------------------- @@ -1562,11 +1559,11 @@ procedure Gnatchop is procedure Write_Source_Reference_Pragma (Info : Unit_Info; Line : Line_Num; - FD : File_Descriptor; + File : Stream_IO.File_Type; EOL : EOL_String; Success : in out Boolean) is - FTE : File_Entry renames File.Table (Info.Chop_File); + FTE : File_Entry renames Gnatchop.File.Table (Info.Chop_File); Nam : String_Access; begin @@ -1578,7 +1575,7 @@ procedure Gnatchop is end if; declare - Reference : aliased String := + Reference : String := "pragma Source_Reference (000000, """ & Nam.all & """);" & EOL.Str; @@ -1601,9 +1598,13 @@ procedure Gnatchop is pragma Assert (Lin = 0); - Success := - Write (FD, Reference'Address, Reference'Length) - = Reference'Length; + begin + String'Write (Stream_IO.Stream (File), Reference); + Success := True; + exception + when others => + Success := False; + end; end; end if; end Write_Source_Reference_Pragma; @@ -1618,12 +1619,36 @@ procedure Gnatchop is TS_Time : OS_Time; Success : out Boolean) is - Info : Unit_Info renames Unit.Table (Num); - FD : File_Descriptor; - Name : aliased constant String := Info.File_Name.all & ASCII.NUL; - Length : File_Offset; - EOL : constant EOL_String := - Get_EOL (Source, Source'First + Info.Offset); + + procedure OS_Filename + (Name : String; + W_Name : Wide_String; + OS_Name : Address; + N_Length : access Natural; + Encoding : Address; + E_Length : access Natural); + pragma Import (C, OS_Filename, "__gnat_os_filename"); + -- Returns in OS_Name the proper name for the OS when used with the + -- returned Encoding value. For example on Windows this will return the + -- UTF-8 encoded name into OS_Name and set Encoding to encoding=utf8 + -- (form parameter Stream_IO). + -- Name is the filename and W_Name the same filename in Unicode 16 bits + -- (this corresponds to Win32 Unicode ISO/IEC 10646). N_Length and + -- E_Length are the length returned in OS_Name and Encoding + -- respectively. + + Info : Unit_Info renames Unit.Table (Num); + Name : aliased constant String := Info.File_Name.all & ASCII.NUL; + W_Name : aliased constant Wide_String := To_Wide_String (Name); + EOL : constant EOL_String := + Get_EOL (Source, Source'First + Info.Offset); + + OS_Name : aliased String (1 .. Name'Length * 2); + O_Length : aliased Natural := OS_Name'Length; + Encoding : aliased String (1 .. 64); + E_Length : aliased Natural := Encoding'Length; + + Length : File_Offset; begin -- Skip duplicated files @@ -1634,60 +1659,77 @@ procedure Gnatchop is return; end if; - if Overwrite_Files then - FD := Create_File (Name'Address, Binary); - else - FD := Create_New_File (Name'Address, Binary); - end if; - - Success := FD /= Invalid_FD; + -- Get OS filename - if not Success then - Error_Msg ("cannot create " & Info.File_Name.all); - return; - end if; + OS_Filename + (Name, W_Name, + OS_Name'Address, O_Length'Access, + Encoding'Address, E_Length'Access); - -- A length of 0 indicates that the rest of the file belongs to - -- this unit. The actual length must be calculated now. Take into - -- account that the last character (EOF) must not be written. + declare + E_Name : constant String := OS_Name (1 .. O_Length); + C_Name : aliased constant String := E_Name & ASCII.Nul; + OS_Encoding : constant String := Encoding (1 .. E_Length); + File : Stream_IO.File_Type; + begin + begin + if not Overwrite_Files and then Exists (E_Name) then + raise Stream_IO.Name_Error; + else + Stream_IO.Create + (File, Stream_IO.Out_File, E_Name, OS_Encoding); + Success := True; + end if; + exception + when Stream_IO.Name_Error | Stream_IO.Use_Error => + Error_Msg ("cannot create " & Info.File_Name.all); + return; + end; - if Info.Length = 0 then - Length := Source'Last - (Source'First + Info.Offset); - else - Length := Info.Length; - end if; + -- A length of 0 indicates that the rest of the file belongs to + -- this unit. The actual length must be calculated now. Take into + -- account that the last character (EOF) must not be written. - -- Prepend configuration pragmas if necessary + if Info.Length = 0 then + Length := Source'Last - (Source'First + Info.Offset); + else + Length := Info.Length; + end if; - if Success and then Info.Bufferg /= null then - Write_Source_Reference_Pragma (Info, 1, FD, EOL, Success); - Success := - Write (FD, Info.Bufferg.all'Address, Info.Bufferg'Length) = - Info.Bufferg'Length; - end if; + -- Prepend configuration pragmas if necessary - Write_Source_Reference_Pragma (Info, Info.Start_Line, FD, EOL, Success); + if Success and then Info.Bufferg /= null then + Write_Source_Reference_Pragma (Info, 1, File, EOL, Success); - if Success then - Success := Write (FD, Source (Source'First + Info.Offset)'Address, - Length) = Length; - end if; + String'Write (Stream_IO.Stream (File), Info.Bufferg.all); + end if; - if not Success then - Error_Msg ("disk full writing " & Info.File_Name.all); - return; - end if; + Write_Source_Reference_Pragma + (Info, Info.Start_Line, File, EOL, Success); - if not Quiet_Mode then - Put_Line (" " & Info.File_Name.all); - end if; + if Success then + begin + String'Write + (Stream_IO.Stream (File), + Source (Source'First + Info.Offset .. + Source'First + Info.Offset + Length - 1)); + exception + when Stream_IO.Use_Error | Stream_IO.Device_Error => + Error_Msg ("disk full writing " & Info.File_Name.all); + return; + end; + end if; - Close (FD); + if not Quiet_Mode then + Put_Line (" " & Info.File_Name.all); + end if; - if Preserve_Mode then - File_Time_Stamp (Name'Address, TS_Time); - end if; + Stream_IO.Close (File); + if Preserve_Mode then + File_Time_Stamp (C_Name'Address, TS_Time); + end if; + end; end Write_Unit; -- Start of processing for gnatchop -- cgit v1.1