+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
-- 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;
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,
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
-- 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.
-- 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
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;
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;
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 --
---------------------------------------
-- 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.
-- 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),
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
-- 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).
-- 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
-- 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.
-- 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;
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 --
----------------------
(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 --
-----------------------
-- 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 --
----------------
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 --
-------------
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.
-- 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
(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);
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;
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
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;
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
-- 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;
-- 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
-- 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
-- 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
-- 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);
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;
-- 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,
-- --
------------------------------------------------------------------------------
-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
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;
-- --
-- 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- --
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 + $;
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 + $;
-- 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 + $;
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;
projects / gcc.git / commitdiff