[multiple changes]
2017-09-29 Bob Duff <duff@adacore.com> * exp_ch6.adb (Expand_Call_Helper): Replace with code more similar to what we had before. (Make_Build_In_Place_Call_In_Object_Declaration): Back out previous change. Set the Etype in the class-wide case. This fixes a regression in the libadalang test suite. 2017-09-29 Joel Brobecker <brobecker@adacore.com> * doc/gnat_ugn/building_executable_programs_with_gnat.rst, doc/gnat_ugn/the_gnat_compilation_model.rst: Avoid use of single colon in comment markup. * gnat_ugn.texi: Regenerate. 2017-09-29 Justin Squirek <squirek@adacore.com> * ali-util.adb, comperr.adb, cprint.adb, errout.adb, fmap.adb, fname-sf.adb, frontend.adb, lib-xref-spark_specific.adb, gnat1drv.adb, gnatls.adb, lib.adb, lib-load.adb, lib-writ.adb, prepcomp.adb, sinput-d.adb, sinput-l.adb, sprint.adb, targparm.adb: Update comparison for checking source file status and error message and/or call to Read_Source_File. * libgnat/s-os_lib.ads: Add new potential value constant for uninitialized file descriptors. * osint.adb, osint.ads (Read_Source_File): Add extra parameter to return result of IO to encompass a read access failure in addition to a file-not-found error. From-SVN: r253294
This commit is contained in:
parent
e75210d645
commit
cd644ae2bc
25 changed files with 159 additions and 71 deletions
|
@ -1,3 +1,32 @@
|
|||
2017-09-29 Bob Duff <duff@adacore.com>
|
||||
|
||||
* exp_ch6.adb (Expand_Call_Helper): Replace with code more similar to
|
||||
what we had before.
|
||||
(Make_Build_In_Place_Call_In_Object_Declaration): Back out previous
|
||||
change. Set the Etype in the class-wide case. This fixes a regression
|
||||
in the libadalang test suite.
|
||||
|
||||
2017-09-29 Joel Brobecker <brobecker@adacore.com>
|
||||
|
||||
* doc/gnat_ugn/building_executable_programs_with_gnat.rst,
|
||||
doc/gnat_ugn/the_gnat_compilation_model.rst: Avoid use of single colon
|
||||
in comment markup.
|
||||
* gnat_ugn.texi: Regenerate.
|
||||
|
||||
2017-09-29 Justin Squirek <squirek@adacore.com>
|
||||
|
||||
* ali-util.adb, comperr.adb, cprint.adb, errout.adb, fmap.adb,
|
||||
fname-sf.adb, frontend.adb, lib-xref-spark_specific.adb, gnat1drv.adb,
|
||||
gnatls.adb, lib.adb, lib-load.adb, lib-writ.adb, prepcomp.adb,
|
||||
sinput-d.adb, sinput-l.adb, sprint.adb, targparm.adb: Update comparison
|
||||
for checking source file status and error message and/or call to
|
||||
Read_Source_File.
|
||||
* libgnat/s-os_lib.ads: Add new potential value constant for
|
||||
uninitialized file descriptors.
|
||||
* osint.adb, osint.ads (Read_Source_File): Add extra parameter to
|
||||
return result of IO to encompass a read access failure in addition to a
|
||||
file-not-found error.
|
||||
|
||||
2017-09-29 Bob Duff <duff@adacore.com>
|
||||
|
||||
* exp_ch6.adb (Expand_Call_Helper): Handle case of build-in-place
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2017, 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- --
|
||||
|
@ -148,7 +148,7 @@ package body ALI.Util is
|
|||
|
||||
Source_Index := Sinput.C.Load_File (Get_Name_String (Full_Name));
|
||||
|
||||
if Source_Index = No_Source_File then
|
||||
if Source_Index <= No_Source_File then
|
||||
return Checksum_Error;
|
||||
end if;
|
||||
|
||||
|
|
|
@ -253,6 +253,7 @@ package body Comperr is
|
|||
-- we use the contents of this file at this point.
|
||||
|
||||
declare
|
||||
FD : File_Descriptor;
|
||||
Lo : Source_Ptr;
|
||||
Hi : Source_Ptr;
|
||||
Src : Source_Buffer_Ptr;
|
||||
|
@ -261,7 +262,7 @@ package body Comperr is
|
|||
Namet.Unlock;
|
||||
Name_Buffer (1 .. 12) := "gnat_bug.box";
|
||||
Name_Len := 12;
|
||||
Read_Source_File (Name_Enter, 0, Hi, Src);
|
||||
Read_Source_File (Name_Enter, 0, Hi, Src, FD);
|
||||
|
||||
-- If we get a Src file, we use it
|
||||
|
||||
|
@ -457,7 +458,7 @@ package body Comperr is
|
|||
-- If parsing was not successful, no Main_Unit is available, so return
|
||||
-- immediately.
|
||||
|
||||
if Main_Source_File = No_Source_File then
|
||||
if Main_Source_File <= No_Source_File then
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
|
|
@ -559,7 +559,7 @@ You may specify any of the following switches to ``gnatmake``:
|
|||
-f, it is equivalent to calling the compiler directly. Note that using
|
||||
-u with a project file and no main has a special meaning.
|
||||
|
||||
.. --Comment:
|
||||
.. --Comment
|
||||
(See :ref:`Project_Files_and_Main_Subprograms`.)
|
||||
|
||||
|
||||
|
|
|
@ -1569,7 +1569,7 @@ depend on a file that no longer exists. Such tools include
|
|||
If you are using project file, a separate mechanism is provided using
|
||||
project attributes.
|
||||
|
||||
.. --Comment:
|
||||
.. --Comment
|
||||
See :ref:`Specifying_Configuration_Pragmas` for more details.
|
||||
|
||||
|
||||
|
|
|
@ -1813,7 +1813,7 @@ package body Errout is
|
|||
-- the Main_Source line is unknown (this happens in error situations,
|
||||
-- e.g. when integrated preprocessing fails).
|
||||
|
||||
if Main_Source_File /= No_Source_File then
|
||||
if Main_Source_File > No_Source_File then
|
||||
Write_Str (" ");
|
||||
Write_Int (Num_Source_Lines (Main_Source_File));
|
||||
|
||||
|
@ -1938,7 +1938,7 @@ package body Errout is
|
|||
-- Source_Reference. This ensures outputting the proper name of
|
||||
-- the source file in this situation.
|
||||
|
||||
if Main_Source_File = No_Source_File
|
||||
if Main_Source_File <= No_Source_File
|
||||
or else Num_SRef_Pragmas (Main_Source_File) /= 0
|
||||
then
|
||||
Current_Error_Source_File := No_Source_File;
|
||||
|
@ -2045,7 +2045,7 @@ package body Errout is
|
|||
|
||||
-- Only write the header if Sfile is known
|
||||
|
||||
if Sfile /= No_Source_File then
|
||||
if Sfile > No_Source_File then
|
||||
Write_Header (Sfile);
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
@ -2066,7 +2066,7 @@ package body Errout is
|
|||
-- Only output the listing if Sfile is known, to avoid
|
||||
-- crashing the compiler.
|
||||
|
||||
if Sfile /= No_Source_File then
|
||||
if Sfile > No_Source_File then
|
||||
for N in 1 .. Last_Source_Line (Sfile) loop
|
||||
while E /= No_Error_Msg
|
||||
and then Errors.Table (E).Deleted
|
||||
|
@ -2141,7 +2141,7 @@ package body Errout is
|
|||
|
||||
-- Output the header only when Main_Source_File is known
|
||||
|
||||
if Main_Source_File /= No_Source_File then
|
||||
if Main_Source_File > No_Source_File then
|
||||
Write_Header (Main_Source_File);
|
||||
end if;
|
||||
|
||||
|
|
|
@ -4330,11 +4330,19 @@ package body Exp_Ch6 is
|
|||
-- result from the secondary stack.
|
||||
|
||||
if Needs_Finalization (Etype (Subp)) then
|
||||
if not Is_Build_In_Place_Function_Call (Call_Node)
|
||||
and then
|
||||
(No (First_Formal (Subp))
|
||||
or else
|
||||
not Is_Concurrent_Record_Type (Etype (First_Formal (Subp))))
|
||||
then
|
||||
Expand_Ctrl_Function_Call (Call_Node);
|
||||
|
||||
-- Build-in-place function calls which appear in anonymous contexts
|
||||
-- need a transient scope to ensure the proper finalization of the
|
||||
-- intermediate result after its use.
|
||||
|
||||
if Is_Build_In_Place_Function_Call (Call_Node)
|
||||
elsif Is_Build_In_Place_Function_Call (Call_Node)
|
||||
and then
|
||||
Nkind_In (Parent (Unqual_Conv (Call_Node)),
|
||||
N_Attribute_Reference,
|
||||
|
@ -4346,14 +4354,6 @@ package body Exp_Ch6 is
|
|||
N_Slice)
|
||||
then
|
||||
Establish_Transient_Scope (Call_Node, Sec_Stack => True);
|
||||
|
||||
elsif not Is_Build_In_Place_Function_Call (Call_Node)
|
||||
and then
|
||||
(No (First_Formal (Subp))
|
||||
or else
|
||||
not Is_Concurrent_Record_Type (Etype (First_Formal (Subp))))
|
||||
then
|
||||
Expand_Ctrl_Function_Call (Call_Node);
|
||||
end if;
|
||||
end if;
|
||||
end Expand_Call_Helper;
|
||||
|
@ -6393,9 +6393,9 @@ package body Exp_Ch6 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- For the case of a simple return that does not come from an extended
|
||||
-- return, in the case of build-in-place, we rewrite "return
|
||||
-- <expression>;" to be:
|
||||
-- For the case of a simple return that does not come from an
|
||||
-- extended return, in the case of build-in-place, we rewrite
|
||||
-- "return <expression>;" to be:
|
||||
|
||||
-- return _anon_ : <return_subtype> := <expression>
|
||||
|
||||
|
@ -8518,6 +8518,18 @@ package body Exp_Ch6 is
|
|||
(Obj_Decl, Original_Node (Obj_Decl));
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- If the object entity has a class-wide Etype, then we need to change
|
||||
-- it to the result subtype of the function call, because otherwise the
|
||||
-- object will be class-wide without an explicit initialization and
|
||||
-- won't be allocated properly by the back end. It seems unclean to make
|
||||
-- such a revision to the type at this point, and we should try to
|
||||
-- improve this treatment when build-in-place functions with class-wide
|
||||
-- results are implemented. ???
|
||||
|
||||
if Is_Class_Wide_Type (Etype (Defining_Identifier (Obj_Decl))) then
|
||||
Set_Etype (Defining_Identifier (Obj_Decl), Result_Subt);
|
||||
end if;
|
||||
end Make_Build_In_Place_Call_In_Object_Declaration;
|
||||
|
||||
-------------------------------------------------
|
||||
|
|
|
@ -175,6 +175,7 @@ package body Fmap is
|
|||
----------------
|
||||
|
||||
procedure Initialize (File_Name : String) is
|
||||
FD : File_Descriptor;
|
||||
Src : Source_Buffer_Ptr;
|
||||
Hi : Source_Ptr;
|
||||
|
||||
|
@ -297,10 +298,14 @@ package body Fmap is
|
|||
|
||||
begin
|
||||
Empty_Tables;
|
||||
Read_Source_File (Name_Enter (File_Name), 1, Hi, Src, Config);
|
||||
Read_Source_File (Name_Enter (File_Name), 1, Hi, Src, FD, Config);
|
||||
|
||||
if Null_Source_Buffer_Ptr (Src) then
|
||||
Write_Str ("warning: could not read mapping file """);
|
||||
if FD = Null_FD then
|
||||
Write_Str ("warning: could not locate mapping file """);
|
||||
else
|
||||
Write_Str ("warning: no read access for mapping file """);
|
||||
end if;
|
||||
Write_Str (File_Name);
|
||||
Write_Line ("""");
|
||||
No_Mapping_File := True;
|
||||
|
|
|
@ -23,12 +23,13 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Casing; use Casing;
|
||||
with Fname; use Fname;
|
||||
with Fname.UF; use Fname.UF;
|
||||
with SFN_Scan; use SFN_Scan;
|
||||
with Osint; use Osint;
|
||||
with Types; use Types;
|
||||
with Casing; use Casing;
|
||||
with Fname; use Fname;
|
||||
with Fname.UF; use Fname.UF;
|
||||
with SFN_Scan; use SFN_Scan;
|
||||
with Osint; use Osint;
|
||||
with Types; use Types;
|
||||
with System.OS_Lib; use System.OS_Lib;
|
||||
|
||||
with Unchecked_Conversion;
|
||||
|
||||
|
@ -61,11 +62,12 @@ package body Fname.SF is
|
|||
-----------------------------------
|
||||
|
||||
procedure Read_Source_File_Name_Pragmas is
|
||||
FD : File_Descriptor;
|
||||
Src : Source_Buffer_Ptr;
|
||||
Hi : Source_Ptr;
|
||||
|
||||
begin
|
||||
Read_Source_File (Name_Enter ("gnat.adc"), 1, Hi, Src);
|
||||
Read_Source_File (Name_Enter ("gnat.adc"), 1, Hi, Src, FD);
|
||||
|
||||
if not Null_Source_Buffer_Ptr (Src) then
|
||||
-- We need to strip off the trailing EOF that was added by
|
||||
|
|
|
@ -126,7 +126,7 @@ begin
|
|||
|
||||
-- Return immediately if the main source could not be found
|
||||
|
||||
if Sinput.Main_Source_File = No_Source_File then
|
||||
if Sinput.Main_Source_File <= No_Source_File then
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
@ -167,7 +167,7 @@ begin
|
|||
|
||||
-- Case of gnat.adc file present
|
||||
|
||||
if Source_gnat_adc /= No_Source_File then
|
||||
if Source_gnat_adc > No_Source_File then
|
||||
-- Parse the gnat.adc file for configuration pragmas
|
||||
|
||||
Initialize_Scanner (No_Unit, Source_gnat_adc);
|
||||
|
@ -213,7 +213,7 @@ begin
|
|||
|
||||
Source_Config_File := Load_Config_File (Config_Name);
|
||||
|
||||
if Source_Config_File = No_Source_File then
|
||||
if Source_Config_File <= No_Source_File then
|
||||
Osint.Fail
|
||||
("cannot find configuration pragmas file "
|
||||
& Config_File_Names (Index).all);
|
||||
|
|
|
@ -852,7 +852,7 @@ procedure Gnat1drv is
|
|||
-- pragma, to be used this way and to cause the body file to be
|
||||
-- ignored in this context).
|
||||
|
||||
if Src_Ind /= No_Source_File
|
||||
if Src_Ind > No_Source_File
|
||||
and then Source_File_Is_Body (Src_Ind)
|
||||
then
|
||||
Errout.Finalize (Last_Call => False);
|
||||
|
@ -1065,6 +1065,11 @@ begin
|
|||
("fatal error, run-time library not installed correctly");
|
||||
Write_Line ("cannot locate file system.ads");
|
||||
raise Unrecoverable_Error;
|
||||
elsif S = No_Access_To_Source_File then
|
||||
Write_Line
|
||||
("fatal error, run-time library not installed correctly");
|
||||
Write_Line ("no read access for file system.ads");
|
||||
raise Unrecoverable_Error;
|
||||
|
||||
-- Read system.ads successfully, remember its source index
|
||||
|
||||
|
@ -1141,7 +1146,7 @@ begin
|
|||
|
||||
-- Exit with errors if the main source could not be parsed
|
||||
|
||||
if Sinput.Main_Source_File = No_Source_File then
|
||||
if Sinput.Main_Source_File <= No_Source_File then
|
||||
Errout.Finalize (Last_Call => True);
|
||||
Errout.Output_Messages;
|
||||
Exit_Program (E_Errors);
|
||||
|
|
|
@ -3193,7 +3193,7 @@ depend on a file that no longer exists. Such tools include
|
|||
If you are using project file, a separate mechanism is provided using
|
||||
project attributes.
|
||||
|
||||
@c --Comment:
|
||||
@c --Comment
|
||||
@c See :ref:`Specifying_Configuration_Pragmas` for more details.
|
||||
|
||||
@node Generating Object Files,Source Dependencies,Configuration Pragmas,The GNAT Compilation Model
|
||||
|
@ -7925,7 +7925,7 @@ Unique. Recompile at most the main files. It implies -c. Combined with
|
|||
-u with a project file and no main has a special meaning.
|
||||
@end table
|
||||
|
||||
@c --Comment:
|
||||
@c --Comment
|
||||
@c (See :ref:`Project_Files_and_Main_Subprograms`.)
|
||||
|
||||
@geindex -U (gnatmake)
|
||||
|
|
|
@ -2097,6 +2097,7 @@ begin
|
|||
|
||||
if RTS_Specified = null then
|
||||
declare
|
||||
FD : File_Descriptor;
|
||||
Text : Source_Buffer_Ptr;
|
||||
Hi : Source_Ptr;
|
||||
|
||||
|
@ -2104,7 +2105,7 @@ begin
|
|||
Name_Buffer (1 .. 10) := "system.ads";
|
||||
Name_Len := 10;
|
||||
|
||||
Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text);
|
||||
Read_Source_File (Name_Find, 0, Hi, Text, FD);
|
||||
|
||||
if Null_Source_Buffer_Ptr (Text) then
|
||||
No_Runtime := True;
|
||||
|
|
|
@ -122,7 +122,7 @@ package body Lib.Load is
|
|||
|
||||
-- No change if we did not find the spec
|
||||
|
||||
if X = No_Source_File then
|
||||
if X <= No_Source_File then
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
@ -326,7 +326,7 @@ package body Lib.Load is
|
|||
Main_Source_File := Load_Source_File (Fname);
|
||||
Current_Error_Source_File := Main_Source_File;
|
||||
|
||||
if Main_Source_File /= No_Source_File then
|
||||
if Main_Source_File > No_Source_File then
|
||||
Version := Source_Checksum (Main_Source_File);
|
||||
else
|
||||
-- To avoid emitting a source location (since there is no file),
|
||||
|
@ -334,7 +334,13 @@ package body Lib.Load is
|
|||
-- in errout.adb.
|
||||
|
||||
Set_Standard_Error;
|
||||
Write_Str ("file """ & Get_Name_String (Fname) & """ not found");
|
||||
if Main_Source_File = No_Access_To_Source_File then
|
||||
Write_Str ("no read access for file """
|
||||
& Get_Name_String (Fname) & """");
|
||||
else
|
||||
Write_Str ("file """
|
||||
& Get_Name_String (Fname) & """ not found");
|
||||
end if;
|
||||
Write_Eol;
|
||||
Set_Standard_Output;
|
||||
end if;
|
||||
|
@ -716,7 +722,7 @@ package body Lib.Load is
|
|||
|
||||
-- File was found
|
||||
|
||||
if Src_Ind /= No_Source_File then
|
||||
if Src_Ind > No_Source_File then
|
||||
Units.Table (Unum) :=
|
||||
(Cunit => Empty,
|
||||
Cunit_Entity => Empty,
|
||||
|
@ -824,7 +830,11 @@ package body Lib.Load is
|
|||
|
||||
else
|
||||
if Debug_Flag_L then
|
||||
Write_Str (" file was not found, load failed");
|
||||
if Src_Ind = No_Access_To_Source_File then
|
||||
Write_Str (" no read access to file, load failed");
|
||||
else
|
||||
Write_Str (" file was not found, load failed");
|
||||
end if;
|
||||
Write_Eol;
|
||||
end if;
|
||||
|
||||
|
@ -857,7 +867,11 @@ package body Lib.Load is
|
|||
|
||||
else
|
||||
Error_Msg_File_1 := Fname;
|
||||
Error_Msg ("file{ not found", Load_Msg_Sloc);
|
||||
if Src_Ind = No_Access_To_Source_File then
|
||||
Error_Msg ("no read access to file{", Load_Msg_Sloc);
|
||||
else
|
||||
Error_Msg ("file{ not found", Load_Msg_Sloc);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Write_Dependency_Chain;
|
||||
|
@ -983,7 +997,7 @@ package body Lib.Load is
|
|||
Unum : constant Unit_Number_Type := Get_Cunit_Unit_Number (U);
|
||||
Fnum : constant Unit_Number_Type := Get_Cunit_Unit_Number (From);
|
||||
begin
|
||||
if Source_Index (Fnum) /= No_Source_File then
|
||||
if Source_Index (Fnum) > No_Source_File then
|
||||
Units.Table (Unum).Version :=
|
||||
Units.Table (Unum).Version
|
||||
xor
|
||||
|
|
|
@ -1464,7 +1464,7 @@ package body Lib.Writ is
|
|||
|
||||
-- Normal case of a unit entry with a source index
|
||||
|
||||
if Sind /= No_Source_File then
|
||||
if Sind > No_Source_File then
|
||||
Fname := File_Name (Sind);
|
||||
|
||||
-- Ensure that on platforms where the file names are not case
|
||||
|
|
|
@ -249,7 +249,7 @@ package body SPARK_Specific is
|
|||
-- Source file could be inexistant as a result of an error, if option
|
||||
-- gnatQ is used.
|
||||
|
||||
if File = No_Source_File then
|
||||
if File <= No_Source_File then
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
|
|
@ -626,7 +626,7 @@ package body Lib is
|
|||
Source_File := Get_Source_File_Index (S);
|
||||
|
||||
if Unwind_Instances then
|
||||
while Template (Source_File) /= No_Source_File loop
|
||||
while Template (Source_File) > No_Source_File loop
|
||||
Source_File := Template (Source_File);
|
||||
end loop;
|
||||
end if;
|
||||
|
|
|
@ -191,6 +191,9 @@ package System.OS_Lib is
|
|||
Invalid_FD : constant File_Descriptor := -1;
|
||||
-- File descriptor returned when error in opening/creating file
|
||||
|
||||
Null_FD : constant File_Descriptor := -2;
|
||||
-- Uninitialized file descriptor
|
||||
|
||||
procedure Close (FD : File_Descriptor; Status : out Boolean);
|
||||
-- Close file referenced by FD. Status is False if the underlying service
|
||||
-- failed. Reasons for failure include: disk full, disk quotas exceeded
|
||||
|
|
|
@ -2565,9 +2565,10 @@ package body Osint is
|
|||
Lo : Source_Ptr;
|
||||
Hi : out Source_Ptr;
|
||||
Src : out Source_Buffer_Ptr;
|
||||
FD : out File_Descriptor;
|
||||
T : File_Type := Source)
|
||||
is
|
||||
Source_File_FD : File_Descriptor;
|
||||
-- Source_File_FD : File_Descriptor;
|
||||
-- The file descriptor for the current source file. A negative value
|
||||
-- indicates failure to open the specified source file.
|
||||
|
||||
|
@ -2594,6 +2595,7 @@ package body Osint is
|
|||
Fail ("Cannot find: " & Name_Buffer (1 .. Name_Len));
|
||||
end if;
|
||||
|
||||
FD := Null_FD;
|
||||
Src := null;
|
||||
Hi := No_Location;
|
||||
return;
|
||||
|
@ -2607,9 +2609,9 @@ package body Osint is
|
|||
-- DOS or Unix mode files, and there is no point in wasting time on
|
||||
-- text translation when it is not required.
|
||||
|
||||
Source_File_FD := Open_Read (Name_Buffer'Address, Binary);
|
||||
FD := Open_Read (Name_Buffer'Address, Binary);
|
||||
|
||||
if Source_File_FD = Invalid_FD then
|
||||
if FD = Invalid_FD then
|
||||
Src := null;
|
||||
Hi := No_Location;
|
||||
return;
|
||||
|
@ -2645,7 +2647,7 @@ package body Osint is
|
|||
|
||||
-- Prepare to read data from the file
|
||||
|
||||
Len := Integer (File_Length (Source_File_FD));
|
||||
Len := Integer (File_Length (FD));
|
||||
|
||||
-- Set Hi so that length is one more than the physical length,
|
||||
-- allowing for the extra EOF character at the end of the buffer
|
||||
|
@ -2665,7 +2667,7 @@ package body Osint is
|
|||
|
||||
Hi := Lo;
|
||||
loop
|
||||
Actual_Len := Read (Source_File_FD, Var_Ptr (Hi)'Address, Len);
|
||||
Actual_Len := Read (FD, Var_Ptr (Hi)'Address, Len);
|
||||
Hi := Hi + Source_Ptr (Actual_Len);
|
||||
exit when Actual_Len = Len or else Actual_Len <= 0;
|
||||
end loop;
|
||||
|
@ -2676,7 +2678,7 @@ package body Osint is
|
|||
|
||||
-- Read is complete, get time stamp and close file and we are done
|
||||
|
||||
Close (Source_File_FD, Status);
|
||||
Close (FD, Status);
|
||||
|
||||
-- The status should never be False. But, if it is, what can we do?
|
||||
-- So, we don't test it.
|
||||
|
|
|
@ -401,6 +401,7 @@ package Osint is
|
|||
Lo : Source_Ptr;
|
||||
Hi : out Source_Ptr;
|
||||
Src : out Source_Buffer_Ptr;
|
||||
FD : out File_Descriptor;
|
||||
T : File_Type := Source);
|
||||
-- Allocates a Source_Buffer of appropriate length and then reads the
|
||||
-- entire contents of the source file N into the buffer. The address of
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2003-2016, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2003-2017, 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- --
|
||||
|
@ -637,7 +637,7 @@ package body Prepcomp is
|
|||
T : constant Nat := Total_Errors_Detected;
|
||||
|
||||
begin
|
||||
if Deffile = No_Source_File then
|
||||
if Deffile <= No_Source_File then
|
||||
Fail ("definition file """
|
||||
& Get_Name_String (N)
|
||||
& """ not found");
|
||||
|
|
|
@ -23,10 +23,11 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Debug; use Debug;
|
||||
with Osint; use Osint;
|
||||
with Osint.C; use Osint.C;
|
||||
with Output; use Output;
|
||||
with Debug; use Debug;
|
||||
with Osint; use Osint;
|
||||
with Osint.C; use Osint.C;
|
||||
with Output; use Output;
|
||||
with System.OS_Lib; use System.OS_Lib;
|
||||
|
||||
package body Sinput.D is
|
||||
|
||||
|
@ -38,6 +39,7 @@ package body Sinput.D is
|
|||
------------------------
|
||||
|
||||
procedure Close_Debug_Source is
|
||||
FD : File_Descriptor;
|
||||
SFR : Source_File_Record renames Source_File.Table (Dfile);
|
||||
Src : Source_Buffer_Ptr;
|
||||
begin
|
||||
|
@ -48,7 +50,7 @@ package body Sinput.D is
|
|||
-- subsequent access.
|
||||
|
||||
Read_Source_File
|
||||
(SFR.Full_Debug_Name, SFR.Source_First, SFR.Source_Last, Src);
|
||||
(SFR.Full_Debug_Name, SFR.Source_First, SFR.Source_Last, Src, FD);
|
||||
SFR.Source_Text := Src;
|
||||
pragma Assert (SFR.Source_Text'First = SFR.Source_First);
|
||||
pragma Assert (SFR.Source_Text'Last = SFR.Source_Last);
|
||||
|
|
|
@ -354,6 +354,7 @@ package body Sinput.L is
|
|||
(N : File_Name_Type;
|
||||
T : Osint.File_Type) return Source_File_Index
|
||||
is
|
||||
FD : File_Descriptor;
|
||||
Src : Source_Buffer_Ptr;
|
||||
X : Source_File_Index;
|
||||
Lo : Source_Ptr;
|
||||
|
@ -411,12 +412,16 @@ package body Sinput.L is
|
|||
Source_Align) * Source_Align;
|
||||
end if;
|
||||
|
||||
Osint.Read_Source_File (N, Lo, Hi, Src, T);
|
||||
Osint.Read_Source_File (N, Lo, Hi, Src, FD, T);
|
||||
|
||||
if Null_Source_Buffer_Ptr (Src) then
|
||||
Source_File.Decrement_Last;
|
||||
return No_Source_File;
|
||||
|
||||
if FD = Null_FD then
|
||||
return No_Source_File;
|
||||
else
|
||||
return No_Access_To_Source_File;
|
||||
end if;
|
||||
else
|
||||
if Debug_Flag_L then
|
||||
Write_Eol;
|
||||
|
|
|
@ -3752,7 +3752,7 @@ package body Sprint is
|
|||
-- Ignore if there is no current source file, or we're not in dump
|
||||
-- source text mode, or if in freeze actions.
|
||||
|
||||
if Current_Source_File /= No_Source_File
|
||||
if Current_Source_File > No_Source_File
|
||||
and then Dump_Source_Text
|
||||
and then Freeze_Indent = 0
|
||||
then
|
||||
|
|
|
@ -23,10 +23,11 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Csets; use Csets;
|
||||
with Csets; use Csets;
|
||||
with Opt;
|
||||
with Osint; use Osint;
|
||||
with Output; use Output;
|
||||
with Osint; use Osint;
|
||||
with Output; use Output;
|
||||
with System.OS_Lib; use System.OS_Lib;
|
||||
|
||||
package body Targparm is
|
||||
use ASCII;
|
||||
|
@ -156,6 +157,7 @@ package body Targparm is
|
|||
Set_NUA : Set_NUA_Type := null;
|
||||
Set_NUP : Set_NUP_Type := null)
|
||||
is
|
||||
FD : File_Descriptor;
|
||||
Text : Source_Buffer_Ptr;
|
||||
Hi : Source_Ptr;
|
||||
|
||||
|
@ -167,11 +169,15 @@ package body Targparm is
|
|||
Name_Buffer (1 .. 10) := "system.ads";
|
||||
Name_Len := 10;
|
||||
|
||||
Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text);
|
||||
Read_Source_File (Name_Find, 0, Hi, Text, FD);
|
||||
|
||||
if Null_Source_Buffer_Ptr (Text) then
|
||||
Write_Line ("fatal error, run-time library not installed correctly");
|
||||
Write_Line ("cannot locate file system.ads");
|
||||
if FD = Null_FD then
|
||||
Write_Line ("cannot locate file system.ads");
|
||||
else
|
||||
Write_Line ("no read access for file system.ads");
|
||||
end if;
|
||||
raise Unrecoverable_Error;
|
||||
end if;
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue