From cd644ae2bc0ce62b88f786ce5a68ad0ba2509ec6 Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Fri, 29 Sep 2017 15:33:23 +0000 Subject: [PATCH] [multiple changes] MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 2017-09-29 Bob Duff * 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 * 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 * 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 --- gcc/ada/ChangeLog | 29 +++++++++++++++ gcc/ada/ali-util.adb | 4 +-- gcc/ada/comperr.adb | 5 +-- ...building_executable_programs_with_gnat.rst | 2 +- .../gnat_ugn/the_gnat_compilation_model.rst | 2 +- gcc/ada/errout.adb | 10 +++--- gcc/ada/exp_ch6.adb | 36 ++++++++++++------- gcc/ada/fmap.adb | 9 +++-- gcc/ada/fname-sf.adb | 16 +++++---- gcc/ada/frontend.adb | 6 ++-- gcc/ada/gnat1drv.adb | 9 +++-- gcc/ada/gnat_ugn.texi | 4 +-- gcc/ada/gnatls.adb | 3 +- gcc/ada/lib-load.adb | 28 +++++++++++---- gcc/ada/lib-writ.adb | 2 +- gcc/ada/lib-xref-spark_specific.adb | 2 +- gcc/ada/lib.adb | 2 +- gcc/ada/libgnat/s-os_lib.ads | 3 ++ gcc/ada/osint.adb | 14 ++++---- gcc/ada/osint.ads | 1 + gcc/ada/prepcomp.adb | 4 +-- gcc/ada/sinput-d.adb | 12 ++++--- gcc/ada/sinput-l.adb | 9 +++-- gcc/ada/sprint.adb | 2 +- gcc/ada/targparm.adb | 16 ++++++--- 25 files changed, 159 insertions(+), 71 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c71ad27325b..4e931f9a6ff 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2017-09-29 Bob Duff + + * 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 + + * 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 + + * 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 * exp_ch6.adb (Expand_Call_Helper): Handle case of build-in-place diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index 40e2276fb65..ea4e8567f94 100644 --- a/gcc/ada/ali-util.adb +++ b/gcc/ada/ali-util.adb @@ -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; diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb index 1b5aa3ebfe5..e76081c2ed0 100644 --- a/gcc/ada/comperr.adb +++ b/gcc/ada/comperr.adb @@ -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; diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index ec152f27de3..046fe35a825 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -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`.) diff --git a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst index 8c3b074ec8d..248bf8ef97f 100644 --- a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst +++ b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst @@ -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. diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index ce99fd842d0..a402c684101 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -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; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 5fcd1f587cd..715e74cfebe 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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 - -- ;" 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 ;" to be: -- return _anon_ : := @@ -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; ------------------------------------------------- diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index d517c2a4ddc..4345dfa8005 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -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; diff --git a/gcc/ada/fname-sf.adb b/gcc/ada/fname-sf.adb index be115bca0b7..53cc9d19f1c 100644 --- a/gcc/ada/fname-sf.adb +++ b/gcc/ada/fname-sf.adb @@ -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 diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index c55085856c0..bb28eae1192 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -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); diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 0e3bc27becb..882631f9bee 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -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); diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 5fdb2724ba1..49abd462265 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -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) diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 925ae2c7836..f45305f9e81 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -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; diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index f509721c398..1419422887f 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -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 diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 8c36957228c..d263b05dc1c 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -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 diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb index b6ddd93783c..4d221749907 100644 --- a/gcc/ada/lib-xref-spark_specific.adb +++ b/gcc/ada/lib-xref-spark_specific.adb @@ -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; diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 16c8afc9ccb..9373f9519e7 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -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; diff --git a/gcc/ada/libgnat/s-os_lib.ads b/gcc/ada/libgnat/s-os_lib.ads index 5fba00aad64..813ed1a9730 100644 --- a/gcc/ada/libgnat/s-os_lib.ads +++ b/gcc/ada/libgnat/s-os_lib.ads @@ -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 diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 105e866c373..781db47d0af 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -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. diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index 2805bfe62ad..4d6a4a4d8cd 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -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 diff --git a/gcc/ada/prepcomp.adb b/gcc/ada/prepcomp.adb index cffb0cef991..7c56130c113 100644 --- a/gcc/ada/prepcomp.adb +++ b/gcc/ada/prepcomp.adb @@ -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"); diff --git a/gcc/ada/sinput-d.adb b/gcc/ada/sinput-d.adb index c9c128b8bbf..f8c4cb0ce14 100644 --- a/gcc/ada/sinput-d.adb +++ b/gcc/ada/sinput-d.adb @@ -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); diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index 360e7117e45..48061238659 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -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; diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 6e293109379..0052409b552 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -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 diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index 4855db50b15..725bb4c2867 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -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; -- 2.30.2