+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
-- --
-- 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- --
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;
-- we use the contents of this file at this point.
declare
+ FD : File_Descriptor;
Lo : Source_Ptr;
Hi : Source_Ptr;
Src : Source_Buffer_Ptr;
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
-- 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;
-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`.)
If you are using project file, a separate mechanism is provided using
project attributes.
-.. --Comment:
+.. --Comment
See :ref:`Specifying_Configuration_Pragmas` for more details.
-- 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));
-- 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;
-- 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;
-- 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
-- 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;
-- 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,
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;
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>
(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;
-------------------------------------------------
----------------
procedure Initialize (File_Name : String) is
+ FD : File_Descriptor;
Src : Source_Buffer_Ptr;
Hi : Source_Ptr;
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;
-- --
------------------------------------------------------------------------------
-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;
-----------------------------------
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
-- 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;
-- 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);
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);
-- 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);
("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
-- 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);
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
-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)
if RTS_Specified = null then
declare
+ FD : File_Descriptor;
Text : Source_Buffer_Ptr;
Hi : Source_Ptr;
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;
-- No change if we did not find the spec
- if X = No_Source_File then
+ if X <= No_Source_File then
return;
end if;
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),
-- 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;
-- 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,
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;
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;
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
-- 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
-- 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;
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;
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
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.
Fail ("Cannot find: " & Name_Buffer (1 .. Name_Len));
end if;
+ FD := Null_FD;
Src := null;
Hi := No_Location;
return;
-- 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;
-- 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
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;
-- 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.
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
-- --
-- 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- --
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");
-- --
------------------------------------------------------------------------------
-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
------------------------
procedure Close_Debug_Source is
+ FD : File_Descriptor;
SFR : Source_File_Record renames Source_File.Table (Dfile);
Src : Source_Buffer_Ptr;
begin
-- 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);
(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;
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;
-- 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
-- --
------------------------------------------------------------------------------
-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;
Set_NUA : Set_NUA_Type := null;
Set_NUP : Set_NUP_Type := null)
is
+ FD : File_Descriptor;
Text : Source_Buffer_Ptr;
Hi : Source_Ptr;
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;
projects / gcc.git / commitdiff