[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:
Pierre-Marie de Rodat 2017-09-29 15:33:23 +00:00
parent e75210d645
commit cd644ae2bc
25 changed files with 159 additions and 71 deletions

View file

@ -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

View file

@ -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;

View file

@ -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;

View file

@ -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`.)

View file

@ -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.

View file

@ -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;

View file

@ -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;
-------------------------------------------------

View file

@ -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;

View file

@ -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

View file

@ -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);

View file

@ -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);

View file

@ -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)

View file

@ -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;

View file

@ -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

View file

@ -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

View file

@ -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;

View file

@ -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;

View file

@ -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

View file

@ -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.

View file

@ -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

View file

@ -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");

View file

@ -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);

View file

@ -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;

View file

@ -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

View file

@ -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;