diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 13 | ||||
| -rw-r--r-- | gcc/ada/ali.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/ali.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/bcheck.adb | 40 | ||||
| -rw-r--r-- | gcc/ada/bindgen.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_strm.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/lib-writ.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/lib-writ.ads | 12 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 13 | ||||
| -rw-r--r-- | gcc/ada/prj-conf.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/s-fileio.adb | 258 | ||||
| -rw-r--r-- | gcc/ada/s-os_lib.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/s-os_lib.ads | 30 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_vfpt.adb | 37 | ||||
| -rw-r--r-- | gcc/ada/sem_vfpt.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 6 | ||||
| -rw-r--r-- | gcc/ada/xr_tabls.adb | 5 |
19 files changed, 92 insertions, 430 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8da2165e..a1e0c19 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2014-08-01 Robert Dewar <dewar@adacore.com> + + * snames.ads-tmpl, s-os_lib.adb, s-os_lib.ads, s-fileio.adb: Remove + VMS-specific code. + * prj-conf.adb: Minor reformatting. + * xr_tabls.adb (Read_File): Restore code which was enabled on + non VMS platforms before. + * prj-env.adb (Initialize_Default_Project_Path): Ditto. + * sem_ch5.adb: Minor reformatting. + * lib-writ.adb, lib-writ.ads, bindgen.adb, sem_vfpt.adb, + sem_vfpt.ads, ali.adb, ali.ads, opt.ads, bcheck.adb, exp_strm.adb: + Remove VMS-specific code. + 2014-08-01 Vincent Celier <celier@adacore.com> * make.adb (Await_Compile): Remove loop that was only needed diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index a899ca7..2fe9552 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -108,7 +108,6 @@ package body ALI is -- ALI files that are read for a given processing run in gnatbind. Dynamic_Elaboration_Checks_Specified := False; - Float_Format_Specified := ' '; Locking_Policy_Specified := ' '; No_Normalize_Scalars_Specified := False; No_Object_Specified := False; @@ -876,7 +875,6 @@ package body ALI is First_Sdep => No_Sdep_Id, First_Specific_Dispatching => Specific_Dispatching.Last + 1, First_Unit => No_Unit_Id, - Float_Format => 'I', Last_Interrupt_State => Interrupt_States.Last, Last_Sdep => No_Sdep_Id, Last_Specific_Dispatching => Specific_Dispatching.Last, @@ -1091,12 +1089,6 @@ package body ALI is ALIs.Table (Id).Partition_Elaboration_Policy := Partition_Elaboration_Policy_Specified; - -- Processing for FD/FG/FI - - elsif C = 'F' then - Float_Format_Specified := Getc; - ALIs.Table (Id).Float_Format := Float_Format_Specified; - -- Processing for Lx elsif C = 'L' then diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 130284b..f896e7d 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -176,10 +176,6 @@ package ALI is -- always be set as well in this case. Not set if 'P' appears in -- Ignore_Lines. - Float_Format : Character; - -- Set to float format (set to I if no float-format given). Not set if - -- 'P' appears in Ignore_Lines. - No_Object : Boolean; -- Set to True if no object file generated. Not set if 'P' appears in -- Ignore_Lines. @@ -469,11 +465,6 @@ package ALI is -- Set to False by Initialize_ALI. Set to True if Scan_ALI reads -- a unit for which dynamic elaboration checking is enabled. - Float_Format_Specified : Character := ' '; - -- Set to blank by Initialize_ALI. Set to appropriate float format - -- character (V or I, see Opt.Float_Format) if an ali file that - -- is read contains an F line setting the floating point format. - Initialize_Scalars_Used : Boolean := False; -- Set True if an ali file contains the Initialize_Scalars flag diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index a141013..be48f06 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -47,7 +47,6 @@ package body Bcheck is procedure Check_Consistent_Dispatching_Policy; procedure Check_Consistent_Dynamic_Elaboration_Checking; - procedure Check_Consistent_Floating_Point_Format; procedure Check_Consistent_Interrupt_States; procedure Check_Consistent_Locking_Policy; procedure Check_Consistent_Normalize_Scalars; @@ -73,10 +72,6 @@ package body Bcheck is procedure Check_Configuration_Consistency is begin - if Float_Format_Specified /= ' ' then - Check_Consistent_Floating_Point_Format; - end if; - if Queuing_Policy_Specified /= ' ' then Check_Consistent_Queuing_Policy; end if; @@ -526,41 +521,6 @@ package body Bcheck is end if; end Check_Consistent_Dynamic_Elaboration_Checking; - -------------------------------------------- - -- Check_Consistent_Floating_Point_Format -- - -------------------------------------------- - - -- The rule is that all files must be compiled with the same setting - -- for the floating-point format. - - procedure Check_Consistent_Floating_Point_Format is - begin - -- First search for a unit specifying a floating-point format and then - -- check all remaining units against it. - - Find_Format : for A1 in ALIs.First .. ALIs.Last loop - if ALIs.Table (A1).Float_Format /= ' ' then - Check_Format : declare - Format : constant Character := ALIs.Table (A1).Float_Format; - begin - for A2 in A1 + 1 .. ALIs.Last loop - if ALIs.Table (A2).Float_Format /= Format then - Error_Msg_File_1 := ALIs.Table (A1).Sfile; - Error_Msg_File_2 := ALIs.Table (A2).Sfile; - - Consistency_Error_Msg - ("{ and { compiled with different " & - "floating-point representations"); - exit Find_Format; - end if; - end loop; - end Check_Format; - - exit Find_Format; - end if; - end loop Find_Format; - end Check_Consistent_Floating_Point_Format; - --------------------------------------- -- Check_Consistent_Interrupt_States -- --------------------------------------- diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index a1bb764..8979b77 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -159,10 +159,6 @@ package body Bindgen is -- A value of zero indicates that time slicing should be suppressed. If no -- pragma is present, and no -T switch was used, the value is -1. - -- Float_Format is the float representation in use. Currently the only - -- valid value is 'I' for IEEE. We needed this field in the past for other - -- floating-point formats, and it is retained for possible future use. - -- WC_Encoding shows the wide character encoding method used for the main -- program. This is one of the encoding letters defined in -- System.WCh_Con.WC_Encoding_Letters. diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index dfb5f0d..220e6c2 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -620,11 +620,14 @@ package body Exp_Strm is -- and we are in the body of the default implementation of a 'Read -- attribute, set target type to force a constraint check (13.13.2(35)). -- If the type of the discriminant is currently private, add another - -- unchecked conversion from the full view. - - if Nkind (Targ) = N_Identifier - and then Is_Internal_Name (Chars (Targ)) - and then Is_TSS (Scope (Entity (Targ)), TSS_Stream_Read) + -- unchecked conversion from the full view. We also do this check if + -- this is an elementary read call in the source program (as opposed + -- to one generated as part of a composite read). + + if (Nkind (Targ) = N_Identifier + and then Is_Internal_Name (Chars (Targ)) + and then Is_TSS (Scope (Entity (Targ)), TSS_Stream_Read)) + or else Comes_From_Source (N) then Res := Unchecked_Convert_To (Base_Type (U_Type), diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index c92d0aa..1994a5a 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -1133,20 +1133,6 @@ package body Lib.Writ is Write_Info_Str (" DB"); end if; - if Opt.Float_Format /= ' ' then - Write_Info_Str (" F"); - - if Opt.Float_Format = 'I' then - Write_Info_Char ('I'); - - elsif Opt.Float_Format_Long = 'D' then - Write_Info_Char ('D'); - - else - Write_Info_Char ('G'); - end if; - end if; - if Tasking_Used and then not Is_Predefined_File_Name (Unit_File_Name (Main_Unit)) then diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads index f0e8d9c..941c69f 100644 --- a/gcc/ada/lib-writ.ads +++ b/gcc/ada/lib-writ.ads @@ -192,18 +192,6 @@ package Lib.Writ is -- the units in this file, where x is the first character -- (upper case) of the policy name (e.g. 'C' for Concurrent). - -- FD Configuration pragmas apply to all the units in this file - -- specifying a possibly non-standard floating point format - -- (VAX float with Long_Float using D_Float). - - -- FG Configuration pragmas apply to all the units in this file - -- specifying a possibly non-standard floating point format - -- (VAX float with Long_Float using G_Float). - - -- FI Configuration pragmas apply to all the units in this file - -- specifying a possibly non-standard floating point format - -- (IEEE Float). - -- Lx A valid Locking_Policy pragma applies to all the units in -- this file, where x is the first character (upper case) of -- the policy name (e.g. 'C' for Ceiling_Locking). diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index e2cc76a..68d20f1 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -639,19 +639,6 @@ package Opt is -- Indicates the current setting of Fast_Math mode, as set by the use -- of a Fast_Math pragma (set True by Fast_Math (On)). - Float_Format : Character := ' '; - -- GNAT - -- A non-blank value indicates that a Float_Format pragma has been - -- processed, in which case this variable is set to 'I' for IEEE or to - -- 'V' for VAX. The setting of 'V' is only possible on OpenVMS versions - -- of GNAT. - - Float_Format_Long : Character := ' '; - -- GNAT - -- A non-blank value indicates that a Long_Float pragma has been processed - -- (this pragma is recognized only in OpenVMS versions of GNAT), in which - -- case this variable is set to D or G for D_Float or G_Float. - Force_ALI_Tree_File : Boolean := False; -- GNAT -- Force generation of ALI file even if errors are encountered. Also forces diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 8667e09..095c2d1 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -1418,7 +1418,7 @@ package body Prj.Conf is -- This might raise an Invalid_Config exception - Do_Autoconf; + Do_Autoconf; -- If the config file is not auto-generated, warn if there is any --RTS -- switch, but not when the config file is generated in memory. diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 7a0ecbe..5021e0c 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -2040,6 +2040,32 @@ package body Prj.Env is -- directory correctly. Last := Last - 1; + + else + declare + New_Dir : constant String := + Normalize_Pathname + (Name_Buffer (First .. Last), + Resolve_Links => Opt.Follow_Links_For_Dirs); + New_Len : Natural; + New_Last : Natural; + + begin + -- If the absolute path was resolved and is different from + -- the original, replace original with the resolved path. + + if New_Dir /= Name_Buffer (First .. Last) + and then New_Dir'Length /= 0 + then + New_Len := Name_Len + New_Dir'Length - (Last - First + 1); + New_Last := First + New_Dir'Length - 1; + Name_Buffer (New_Last + 1 .. New_Len) := + Name_Buffer (Last + 1 .. Name_Len); + Name_Buffer (First .. New_Last) := New_Dir; + Name_Len := New_Len; + Last := New_Last; + end if; + end; end if; First := Last + 1; diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index 4c21b85..5659468 100644 --- a/gcc/ada/s-fileio.adb +++ b/gcc/ada/s-fileio.adb @@ -50,12 +50,6 @@ package body System.File_IO is use type CRTL.size_t; use type Interfaces.C.int; - subtype String_Access is System.OS_Lib.String_Access; - procedure Free (X : in out String_Access) renames System.OS_Lib.Free; - - function "=" (X, Y : String_Access) return Boolean - renames System.OS_Lib."="; - ---------------------- -- Global Variables -- ---------------------- @@ -102,9 +96,6 @@ package body System.File_IO is (C, text_translation_required, "__gnat_text_translation_required"); -- If true, add appropriate suffix to control string for Open - VMS_Formstr : String_Access := null; - -- For special VMS RMS keywords and values - ----------------------- -- Local Subprograms -- ----------------------- @@ -139,14 +130,6 @@ package body System.File_IO is -- Clear error indication on File and raise Device_Error with an exception -- message providing errno information. - procedure Form_VMS_RMS_Keys (Form : String; VMS_Form : out String_Access); - -- Parse the RMS Keys - - function Form_RMS_Context_Key - (Form : String; - VMS_Form : String_Access) return Natural; - -- Parse the RMS Context Key - ---------------- -- Append_Set -- ---------------- @@ -630,197 +613,6 @@ package body System.File_IO is Stop := 0; end Form_Parameter; - -------------------------- - -- Form_RMS_Context_Key -- - -------------------------- - - function Form_RMS_Context_Key - (Form : String; - VMS_Form : String_Access) return Natural - is - type Context_Parms is - (Binary_Data, Convert_Fortran_Carriage_Control, Force_Record_Mode, - Force_Stream_Mode, Explicit_Write); - -- Ada-fied list of all possible Context keyword values - - Pos : Natural := 0; - Klen : Natural := 0; - Index : Natural; - - begin - -- Find the end of the occupation - - for J in VMS_Form'First .. VMS_Form'Last loop - if VMS_Form (J) = ASCII.NUL then - Pos := J; - exit; - end if; - end loop; - - Index := Form'First; - while Index < Form'Last loop - if Form (Index) = '=' then - Index := Index + 1; - - -- Loop through the context values and look for a match - - for Parm in Context_Parms loop - declare - KImage : String := Context_Parms'Image (Parm); - - begin - Klen := KImage'Length; - To_Lower (KImage); - - if Index + Klen - 1 <= Form'Last - and then Form (Index .. Index + Klen - 1) = KImage - then - case Parm is - when Force_Record_Mode => - VMS_Form (Pos) := '"'; - Pos := Pos + 1; - VMS_Form (Pos .. Pos + 6) := "ctx=rec"; - Pos := Pos + 7; - VMS_Form (Pos) := '"'; - Pos := Pos + 1; - VMS_Form (Pos) := ','; - return Index + Klen; - - when Force_Stream_Mode => - VMS_Form (Pos) := '"'; - Pos := Pos + 1; - VMS_Form (Pos .. Pos + 6) := "ctx=stm"; - Pos := Pos + 7; - VMS_Form (Pos) := '"'; - Pos := Pos + 1; - VMS_Form (Pos) := ','; - return Index + Klen; - - when others => - raise Use_Error - with "unimplemented RMS Context Value"; - end case; - end if; - end; - end loop; - - raise Use_Error with "unrecognized RMS Context Value"; - end if; - end loop; - - raise Use_Error with "malformed RMS Context Value"; - end Form_RMS_Context_Key; - - ----------------------- - -- Form_VMS_RMS_Keys -- - ----------------------- - - procedure Form_VMS_RMS_Keys (Form : String; VMS_Form : out String_Access) - is - VMS_RMS_Keys_Token : constant String := "vms_rms_keys"; - Klen : Natural := VMS_RMS_Keys_Token'Length; - Index : Natural; - - -- Ada-fied list of all RMS keywords, translated from the HP C Run-Time - -- Library Reference Manual, Table REF-3: RMS Valid Keywords and Values. - - type RMS_Keys is - (Access_Callback, Allocation_Quantity, Block_Size, Context, - Default_Extension_Quantity, Default_File_Name_String, Error_Callback, - File_Processing_Options, Fixed_Header_Size, Global_Buffer_Count, - Multiblock_Count, Multibuffer_Count, Maximum_Record_Size, - Terminal_Input_Prompt, Record_Attributes, Record_Format, - Record_Processing_Options, Retrieval_Pointer_Count, Sharing_Options, - Timeout_IO_Value); - - begin - Index := Form'First + Klen - 1; - while Index < Form'Last loop - Index := Index + 1; - - -- Scan for the token signalling VMS RMS Keys ahead. Should - -- whitespace be eaten??? - - if Form (Index - Klen .. Index - 1) = VMS_RMS_Keys_Token then - - -- Allocate the VMS form string that will contain the cryptic - -- CRTL RMS strings and initialize it to all nulls. Since the - -- CRTL strings are always shorter than the Ada-fied strings, - -- it follows that an allocation of the original size will be - -- more than adequate. - VMS_Form := new String'(Form (Form'First .. Form'Last)); - VMS_Form.all := (others => ASCII.NUL); - - if Form (Index) = '=' then - Index := Index + 1; - if Form (Index) = '(' then - while Index < Form'Last loop - Index := Index + 1; - - -- Loop through the RMS Keys and dispatch - - for Key in RMS_Keys loop - declare - KImage : String := RMS_Keys'Image (Key); - - begin - Klen := KImage'Length; - To_Lower (KImage); - - if Form (Index .. Index + Klen - 1) = KImage then - case Key is - when Context => - Index := Form_RMS_Context_Key - (Form (Index + Klen .. Form'Last), - VMS_Form); - exit; - - when others => - raise Use_Error - with "unimplemented VMS RMS Form Key"; - end case; - end if; - end; - end loop; - - if Form (Index) = ')' then - - -- Done, erase the unneeded trailing comma and return - - for J in reverse VMS_Form'First .. VMS_Form'Last loop - if VMS_Form (J) = ',' then - VMS_Form (J) := ASCII.NUL; - return; - end if; - end loop; - - -- Shouldn't be possible to get here - - raise Use_Error; - - elsif Form (Index) = ',' then - - -- Another key ahead, exit inner loop - - null; - - else - - -- Keyword value not terminated correctly - - raise Use_Error with "malformed VMS RMS Form"; - end if; - end loop; - end if; - end if; - - -- Found the keyword, but not followed by correct syntax - - raise Use_Error with "malformed VMS RMS Form"; - end if; - end loop; - end Form_VMS_RMS_Keys; - ------------- -- Is_Open -- ------------- @@ -1104,17 +896,6 @@ package body System.File_IO is end; end if; - -- Acquire settings of target specific form parameters on VMS. Only - -- Context is currently implemented, for forcing a byte stream mode - -- read. On non-VMS systems, the settings are ultimately ignored in - -- the implementation of __gnat_fopen. - - -- Should a warning be issued on non-VMS systems? That's not possible - -- without testing System.OpenVMS boolean which isn't present in most - -- non-VMS versions of package System. - - Form_VMS_RMS_Keys (Formstr, VMS_Formstr); - -- If we were given a stream (call from xxx.C_Streams.Open), then set -- the full name to the given one, and skip to end of processing. @@ -1286,19 +1067,8 @@ package body System.File_IO is -- since by the time of the delete, the current working directory -- may have changed and we do not want to delete a different file. - if VMS_Formstr = null then - Stream := fopen (Namestr'Address, Fopstr'Address, Encoding, - Null_Address); - else - Stream := fopen (Namestr'Address, Fopstr'Address, Encoding, - VMS_Formstr.all'Address); - end if; - - -- No need to keep this around - - if VMS_Formstr /= null then - Free (VMS_Formstr); - end if; + Stream := + fopen (Namestr'Address, Fopstr'Address, Encoding, Null_Address); if Stream = NULL_Stream then @@ -1450,21 +1220,9 @@ package body System.File_IO is (Mode, File.Text_Encoding in Text_Content_Encoding, False, File.Access_Method, Fopstr); - Form_VMS_RMS_Keys (File.Form.all, VMS_Formstr); - - if VMS_Formstr = null then - File.Stream := freopen - (File.Name.all'Address, Fopstr'Address, File.Stream, - File.Encoding, Null_Address); - else - File.Stream := freopen - (File.Name.all'Address, Fopstr'Address, File.Stream, - File.Encoding, VMS_Formstr.all'Address); - end if; - - if VMS_Formstr /= null then - Free (VMS_Formstr); - end if; + File.Stream := freopen + (File.Name.all'Address, Fopstr'Address, File.Stream, + File.Encoding, Null_Address); if File.Stream = NULL_Stream then Close (File_Ptr); @@ -1483,9 +1241,9 @@ package body System.File_IO is procedure Write_Buf (File : AFCB_Ptr; Buf : Address; Siz : size_t) is begin -- Note: for most purposes, the Siz and 1 parameters in the fwrite call - -- could be reversed, but on VMS, this is a better choice, since for - -- some file formats, reversing the parameters results in records of one - -- byte each. + -- could be reversed, but we have encountered systems where this is a + -- better choice, since for some file formats, reversing the parameters + -- results in records of one byte each. SSL.Abort_Defer.all; diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 940bf51..49d868f 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -96,8 +96,8 @@ package body System.OS_Lib is Stdout : Boolean); -- Internal routine to implement two Create_Temp_File routines. If Stdout -- is set to True the created descriptor is stdout-compatible, otherwise - -- it might not be depending on the OS (VMS is one example). The first two - -- parameters are as in Create_Temp_File. + -- it might not be depending on the OS. The first two parameters are as + -- in Create_Temp_File. function C_String_Length (S : Address) return Integer; -- Returns the length of C (null-terminated) string at S, or 0 for @@ -416,8 +416,8 @@ package body System.OS_Lib is loop R := Read (From, Buffer (1)'Address, Buf_Size); - -- For VMS, the buffer may not be full. So, we need to try again - -- until there is nothing to read. + -- On some systems, the buffer may not be full. So, we need to try + -- again until there is nothing to read. exit when R = 0; @@ -2019,12 +2019,7 @@ package body System.OS_Lib is end loop; end if; - -- Resolve directory names for Windows (formerly also VMS) - - -- On VMS, if we have a Unix path such as /temp/..., and TEMP is a - -- logical name, we must not try to resolve this logical name, because - -- it may have multiple equivalences and if resolved we will only - -- get the first one. + -- Resolve directory names for Windows if On_Windows then diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index b8dde28..78a3eeb 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -368,7 +368,7 @@ package System.OS_Lib is -- effect of "cp -p" on Unix systems, and None corresponds to the typical -- effect of "cp" on Unix systems. - -- Note: Time_Stamps and Full are not supported on VMS and VxWorks 5 + -- Note: Time_Stamps and Full are not supported on VxWorks 5 procedure Copy_File (Name : String; @@ -384,20 +384,14 @@ package System.OS_Lib is -- True or False indicating if the copy is successful (depending on the -- specified Mode). -- - -- Note: this procedure is only supported to a very limited extent on VMS. - -- The only supported mode is Overwrite, and the only supported value for - -- Preserve is None, resulting in the default action which for Overwrite - -- is to leave attributes unchanged. Furthermore, the copy only works for - -- simple text files. - procedure Copy_Time_Stamps (Source, Dest : String; Success : out Boolean); -- Copy Source file time stamps (last modification and last access time -- stamps) to Dest file. Source and Dest must be valid filenames, -- furthermore Dest must be writable. Success will be set to True if the -- operation was successful and False otherwise. -- - -- Note: this procedure is not supported on VMS and VxWorks 5. On these - -- platforms, Success is always set to False. + -- Note: this procedure is not supported on VxWorks 5. On this platform, + -- Success is always set to False. procedure Set_File_Last_Modify_Time_Stamp (Name : String; Time : OS_Time); -- Given the name of a file or directory, Name, set the last modification @@ -484,17 +478,13 @@ package System.OS_Lib is -- e.g. A is a symbolic link for B, and B is a symbolic link for A), then -- Normalize_Pathname returns an empty string. -- - -- In VMS, if Name follows the VMS syntax file specification, it is first - -- converted into Unix syntax. If the conversion fails, Normalize_Pathname - -- returns an empty string. - -- -- For case-sensitive file systems, the value of Case_Sensitive parameter -- is ignored. For file systems that are not case-sensitive, such as - -- Windows and OpenVMS, if this parameter is set to False, then the file - -- and directory names are folded to lower case. This allows checking - -- whether two files are the same by applying this function to their names - -- and comparing the results. If Case_Sensitive is set to True, this - -- function does not change the casing of file and directory names. + -- Windows, if this parameter is set to False, then the file and directory + -- names are folded to lower case. This allows checking whether two files + -- are the same by applying this function to their names and comparing the + -- results. If Case_Sensitive is set to True, this function does not change + -- the casing of file and directory names. function Is_Absolute_Path (Name : String) return Boolean; -- Returns True if Name is an absolute path name, i.e. it designates a @@ -894,7 +884,7 @@ package System.OS_Lib is -- On Solaris: fork1, followed in the child process by execv - -- On other Unix-like systems, and on VMS: fork, followed in the child + -- On other Unix-like systems: fork, followed in the child -- process by execv. -- On vxworks, nucleus, and RTX, spawning of processes is not supported @@ -960,7 +950,7 @@ package System.OS_Lib is -- set an explicit null as the value, or to remove the entry, this is -- operating system dependent). Note that any following calls to Spawn -- will pass an environment to the spawned process that includes the - -- changes made by Setenv calls. This procedure is not available on VMS. + -- changes made by Setenv calls. procedure OS_Exit (Status : Integer); pragma No_Return (OS_Exit); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 1e55e33..5013bcd 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1753,8 +1753,9 @@ package body Sem_Ch5 is if not Is_Array_Type (Etype (Iter_Name)) then declare Iterator : constant Entity_Id := - Find_Value_Of_Aspect - (Etype (Iter_Name), Aspect_Default_Iterator); + Find_Value_Of_Aspect + (Etype (Iter_Name), Aspect_Default_Iterator); + I : Interp_Index; It : Interp; @@ -1852,11 +1853,11 @@ package body Sem_Ch5 is -- The name in the renaming declaration may be a function call. -- Indicate that it does not come from source, to suppress - -- spurious warnings on renamings of parameterless functions, - -- a common enough idiom in user-defined iterators. - -- The entity of the renaming must be a variable, because user- - -- defined Iterate function may have in-out parameters, even - -- if predefined ones do not. + -- spurious warnings on renamings of parameterless functions, a + -- common enough idiom in user-defined iterators. The entity of + -- the renaming must be a variable, because user- defined Iterate + -- function may have in-out parameters, even if predefined ones do + -- not. Decl := Make_Object_Renaming_Declaration (Loc, diff --git a/gcc/ada/sem_vfpt.adb b/gcc/ada/sem_vfpt.adb index d81298e..b2e495a 100644 --- a/gcc/ada/sem_vfpt.adb +++ b/gcc/ada/sem_vfpt.adb @@ -23,11 +23,9 @@ -- -- ------------------------------------------------------------------------------ -with CStand; use CStand; -with Einfo; use Einfo; -with Opt; use Opt; -with Stand; use Stand; -with Targparm; use Targparm; +with CStand; use CStand; +with Einfo; use Einfo; +with Stand; use Stand; package body Sem_VFpt is @@ -134,32 +132,9 @@ package body Sem_VFpt is procedure Set_Standard_Fpt_Formats is begin - -- IEEE case - - if Opt.Float_Format = 'I' then - Set_IEEE_Short (Standard_Float); - Set_IEEE_Long (Standard_Long_Float); - Set_IEEE_Long (Standard_Long_Long_Float); - - -- Vax float case - - else - Set_F_Float (Standard_Float); - - if Opt.Float_Format_Long = 'D' then - Set_D_Float (Standard_Long_Float); - else - Set_G_Float (Standard_Long_Float); - end if; - - -- Note: Long_Long_Float gets set only in the real VMS case, - -- because this gives better results for testing out the use - -- of VAX float on non-VMS environments with the -gnatdm switch. - - if OpenVMS_On_Target then - Set_G_Float (Standard_Long_Long_Float); - end if; - end if; + Set_IEEE_Short (Standard_Float); + Set_IEEE_Long (Standard_Long_Float); + Set_IEEE_Long (Standard_Long_Long_Float); end Set_Standard_Fpt_Formats; end Sem_VFpt; diff --git a/gcc/ada/sem_vfpt.ads b/gcc/ada/sem_vfpt.ads index b6c9465..1c94866 100644 --- a/gcc/ada/sem_vfpt.ads +++ b/gcc/ada/sem_vfpt.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2014, 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- -- diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 0b9220d..12ff465 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -499,7 +499,7 @@ package Snames is Name_External : constant Name_Id := N + $; -- GNAT Name_Finalize_Storage_Only : constant Name_Id := N + $; -- GNAT Name_Global : constant Name_Id := N + $; -- GNAT - Name_Ident : constant Name_Id := N + $; -- VMS + Name_Ident : constant Name_Id := N + $; -- GNAT Name_Implementation_Defined : constant Name_Id := N + $; -- GNAT Name_Implemented : constant Name_Id := N + $; -- Ada 12 Name_Import : constant Name_Id := N + $; @@ -801,7 +801,6 @@ package Snames is Name_Variant : constant Name_Id := N + $; Name_VAX_Float : constant Name_Id := N + $; Name_Vector : constant Name_Id := N + $; - Name_VMS : constant Name_Id := N + $; Name_Vtable_Ptr : constant Name_Id := N + $; Name_Warn : constant Name_Id := N + $; Name_Working_Storage : constant Name_Id := N + $; @@ -814,9 +813,6 @@ package Snames is -- implemented in all Ada modes. Full descriptions of these implementation -- dependent attributes may be found in the appropriate Sem_Attr section. - -- The entries marked VMS are recognized only in OpenVMS implementations - -- of GNAT, and are treated as illegal in all other contexts. - First_Attribute_Name : constant Name_Id := N + $; Name_Abort_Signal : constant Name_Id := N + $; -- GNAT Name_Access : constant Name_Id := N + $; diff --git a/gcc/ada/xr_tabls.adb b/gcc/ada/xr_tabls.adb index 25a775f..0b97c12 100644 --- a/gcc/ada/xr_tabls.adb +++ b/gcc/ada/xr_tabls.adb @@ -1135,6 +1135,11 @@ package body Xr_Tabls is Buffer (Read_Ptr) := EOF; Contents := new String'(Buffer (1 .. Read_Ptr)); + + if Read_Ptr /= Length + 1 then + raise Ada.Text_IO.End_Error; + end if; + Close (FD); end; end Read_File; |