From 94d3a18d33399c807647294c973f263096fae095 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 11:12:31 +0200 Subject: [PATCH] [multiple changes] 2017-04-25 Hristian Kirtchev * make.adb, par-ch2.adb, sem_util.adb, scans.ads, sem_ch8.adb, scn.adb, osint.adb, fname.adb: Minor reformatting. 2017-04-25 Pascal Obry * s-taprop-mingw.adb: Do not check for CloseHandle in Finalize_TCB. From-SVN: r247153 --- gcc/ada/ChangeLog | 10 +++++ gcc/ada/fname.adb | 84 +++++++++++++++++++++++++------------- gcc/ada/make.adb | 2 +- gcc/ada/osint.adb | 4 +- gcc/ada/par-ch2.adb | 48 ++++++++++++---------- gcc/ada/s-taprop-mingw.adb | 6 ++- gcc/ada/scans.ads | 8 ++-- gcc/ada/scn.adb | 3 +- gcc/ada/sem_ch8.adb | 6 +-- gcc/ada/sem_util.adb | 5 ++- 10 files changed, 112 insertions(+), 64 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 917785a5bfa..23ba4722881 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2017-04-25 Hristian Kirtchev + + * make.adb, par-ch2.adb, sem_util.adb, scans.ads, sem_ch8.adb, + scn.adb, osint.adb, fname.adb: Minor reformatting. + +2017-04-25 Pascal Obry + + * s-taprop-mingw.adb: Do not check for CloseHandle in + Finalize_TCB. + 2017-04-25 Hristian Kirtchev * sem_util.adb (Check_Part_Of_Reference): diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb index 9ee2e9a936c..5905dfb9b39 100644 --- a/gcc/ada/fname.adb +++ b/gcc/ada/fname.adb @@ -57,6 +57,10 @@ package body Fname is Table_Increment => Alloc.SFN_Table_Increment, Table_Name => "Fname_Dummy_Table"); + function Has_Internal_Extension (Fname : String) return Boolean; + -- True if the extension is ".ads" or ".adb", as is always the case for + -- internal/predefined units. + function Has_Prefix (X, Prefix : String) return Boolean; -- True if Prefix is at the beginning of X. For example, -- Has_Prefix("a-filename.ads", Prefix => "a-") is True. @@ -64,18 +68,15 @@ package body Fname is function Has_Suffix (X, Suffix : String) return Boolean; -- True if Suffix is at the end of X - function Has_Internal_Extension (Fname : String) return Boolean; - -- True if the extension is ".ads" or ".adb", as is always the case for - -- internal/predefined units. - ---------------------------- -- Has_Internal_Extension -- ---------------------------- function Has_Internal_Extension (Fname : String) return Boolean is begin - return Has_Suffix (Fname, Suffix => ".ads") - or else Has_Suffix (Fname, Suffix => ".adb"); + return + Has_Suffix (Fname, Suffix => ".ads") + or else Has_Suffix (Fname, Suffix => ".adb"); end Has_Internal_Extension; ---------------- @@ -87,7 +88,7 @@ package body Fname is if X'Length >= Prefix'Length then declare Slice : String renames - X (X'First .. X'First + Prefix'Length - 1); + X (X'First .. X'First + Prefix'Length - 1); begin return Slice = Prefix; end; @@ -104,7 +105,7 @@ package body Fname is if X'Length >= Suffix'Length then declare Slice : String renames - X (X'Last - Suffix'Length + 1 .. X'Last); + X (X'Last - Suffix'Length + 1 .. X'Last); begin return Slice = Suffix; end; @@ -118,7 +119,8 @@ package body Fname is function Is_Internal_File_Name (Fname : String; - Renamings_Included : Boolean := True) return Boolean is + Renamings_Included : Boolean := True) return Boolean + is begin -- Check for internal extensions first, so we don't think (e.g.) -- "gnat.adc" is internal. @@ -127,9 +129,10 @@ package body Fname is return False; end if; - return Is_Predefined_File_Name (Fname, Renamings_Included) - or else Has_Prefix (Fname, Prefix => "g-") - or else Has_Prefix (Fname, Prefix => "gnat.ad"); + return + Is_Predefined_File_Name (Fname, Renamings_Included) + or else Has_Prefix (Fname, Prefix => "g-") + or else Has_Prefix (Fname, Prefix => "gnat.ad"); end Is_Internal_File_Name; function Is_Internal_File_Name @@ -137,8 +140,9 @@ package body Fname is Renamings_Included : Boolean := True) return Boolean is begin - return Is_Internal_File_Name - (Get_Name_String (Fname), Renamings_Included); + return + Is_Internal_File_Name + (Get_Name_String (Fname), Renamings_Included); end Is_Internal_File_Name; ----------------------------- @@ -147,7 +151,8 @@ package body Fname is function Is_Predefined_File_Name (Fname : String; - Renamings_Included : Boolean := True) return Boolean is + Renamings_Included : Boolean := True) return Boolean + is begin if not Has_Internal_Extension (Fname) then return False; @@ -166,9 +171,9 @@ package body Fname is return False; end if; - if Has_Prefix (Fname, Prefix => "ada.ad") -- Ada - or else Has_Prefix (Fname, Prefix => "interfac.ad") -- Interfaces - or else Has_Prefix (Fname, Prefix => "system.ad") -- System + if Has_Prefix (Fname, Prefix => "ada.ad") -- Ada + or else Has_Prefix (Fname, Prefix => "interfac.ad") -- Interfaces + or else Has_Prefix (Fname, Prefix => "system.ad") -- System then return True; end if; @@ -179,16 +184,38 @@ package body Fname is -- The following are the predefined renamings - return Has_Prefix (Fname, Prefix => "calendar.ad") -- Calendar - or else Has_Prefix (Fname, Prefix => "machcode.ad") -- Machine_Code - or else Has_Prefix (Fname, Prefix => "unchconv.ad") + return + -- Calendar + + Has_Prefix (Fname, Prefix => "calendar.ad") + + -- Machine_Code + + or else Has_Prefix (Fname, Prefix => "machcode.ad") + -- Unchecked_Conversion - or else Has_Prefix (Fname, Prefix => "unchdeal.ad") + + or else Has_Prefix (Fname, Prefix => "unchconv.ad") + -- Unchecked_Deallocation - or else Has_Prefix (Fname, Prefix => "directio.ad") -- Direct_IO - or else Has_Prefix (Fname, Prefix => "ioexcept.ad") -- IO_Exceptions - or else Has_Prefix (Fname, Prefix => "sequenio.ad") -- Sequential_IO - or else Has_Prefix (Fname, Prefix => "text_io.ad"); -- Text_IO + + or else Has_Prefix (Fname, Prefix => "unchdeal.ad") + + -- Direct_IO + + or else Has_Prefix (Fname, Prefix => "directio.ad") + + -- IO_Exceptions + + or else Has_Prefix (Fname, Prefix => "ioexcept.ad") + + -- Sequential_IO + + or else Has_Prefix (Fname, Prefix => "sequenio.ad") + + -- Text_IO + + or else Has_Prefix (Fname, Prefix => "text_io.ad"); end Is_Predefined_File_Name; function Is_Predefined_File_Name @@ -196,8 +223,9 @@ package body Fname is Renamings_Included : Boolean := True) return Boolean is begin - return Is_Predefined_File_Name - (Get_Name_String (Fname), Renamings_Included); + return + Is_Predefined_File_Name + (Get_Name_String (Fname), Renamings_Included); end Is_Predefined_File_Name; --------------- diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index bfdd2163f41..d6ea05bd5f1 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -2945,7 +2945,7 @@ package body Make is begin if Is_Predefined_File_Name - (Fname, Renamings_Included => False) + (Fname, Renamings_Included => False) then if Check_Readonly_Files or else Must_Compile then Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) := diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index d5f63075fa8..2a3b1c3dbca 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -1187,7 +1187,7 @@ package body Osint is and then Name_Buffer (Name_Len - 2 .. Name_Len) = ".dg") then Found := N; - Attr.all := Unknown_Attributes; + Attr.all := Unknown_Attributes; if T = Config then if Full_Name then @@ -1199,7 +1199,7 @@ package body Osint is begin Name_Buffer (1 .. Full_Size) := Full_Path; Name_Len := Full_Size; - Found := Name_Find; + Found := Name_Find; end; end if; diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index cd79ac3de29..fc8d9cbd721 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -224,26 +224,6 @@ package body Ch2 is -- in fact the bodies ARE present, supplied by these pragmas. function P_Pragma (Skipping : Boolean := False) return Node_Id is - Interface_Check_Required : Boolean := False; - -- Set True if check of pragma INTERFACE is required - - Import_Check_Required : Boolean := False; - -- Set True if check of pragma IMPORT is required - - Arg_Count : Nat := 0; - -- Number of argument associations processed - - Identifier_Seen : Boolean := False; - -- Set True if an identifier is encountered for a pragma argument. Used - -- to check that there are no more arguments without identifiers. - - Prag_Node : Node_Id; - Prag_Name : Name_Id; - Semicolon_Loc : Source_Ptr; - Ident_Node : Node_Id; - Assoc_Node : Node_Id; - Result : Node_Id; - procedure Skip_Pragma_Semicolon; -- Skip past semicolon at end of pragma @@ -265,6 +245,28 @@ package body Ch2 is end if; end Skip_Pragma_Semicolon; + -- Local variables + + Interface_Check_Required : Boolean := False; + -- Set True if check of pragma INTERFACE is required + + Import_Check_Required : Boolean := False; + -- Set True if check of pragma IMPORT is required + + Arg_Count : Nat := 0; + -- Number of argument associations processed + + Identifier_Seen : Boolean := False; + -- Set True if an identifier is encountered for a pragma argument. Used + -- to check that there are no more arguments without identifiers. + + Assoc_Node : Node_Id; + Ident_Node : Node_Id; + Prag_Name : Name_Id; + Prag_Node : Node_Id; + Result : Node_Id; + Semicolon_Loc : Source_Ptr; + -- Start of processing for P_Pragma begin @@ -366,8 +368,8 @@ package body Ch2 is -- Cancel indication of being within a pragma or in particular a Depends -- pragma. - Inside_Pragma := False; Inside_Depends := False; + Inside_Pragma := False; -- Now we have two tasks left, we need to scan out the semicolon -- following the pragma, and we have to call Par.Prag to process @@ -390,10 +392,12 @@ package body Ch2 is Skip_Pragma_Semicolon; return Par.Prag (Prag_Node, Semicolon_Loc); end if; + exception when Error_Resync => Resync_Past_Semicolon; - Inside_Pragma := False; + Inside_Depends := False; + Inside_Pragma := False; return Error; end P_Pragma; diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index aba2367310d..e3d0842953c 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -958,6 +958,7 @@ package body System.Task_Primitives.Operations is procedure Finalize_TCB (T : Task_Id) is Succeeded : BOOL; + pragma Unreferenced (Succeeded); begin if not Single_Lock then @@ -976,7 +977,10 @@ package body System.Task_Primitives.Operations is -- is needed to release system resources. Succeeded := CloseHandle (T.Common.LL.Thread); - pragma Assert (Succeeded = Win32.TRUE); + -- Note that we do not check for the returned value, this is + -- because the above call will fail for a foreign thread. But + -- we still need to call it to properly close Ada tasks created + -- with CreateThread() in Create_Task above. end if; ATCB_Allocation.Free_ATCB (T); diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads index a8972bed4f5..428c1a5b975 100644 --- a/gcc/ada/scans.ads +++ b/gcc/ada/scans.ads @@ -484,10 +484,6 @@ package Scans is -- Is it really right for this to be a Name rather than a String, what -- about the case of Wide_Wide_Characters??? - Inside_Pragma : Boolean := False; - -- True within a pragma. Used to avoid complaining about reserved words - -- within pragmas (see Scan_Reserved_Identifier). - Inside_Depends : Boolean := False; -- True while parsing the argument of a Depends pragma or aspect (used to -- allow/require non-standard style rules for =>+ with -gnatyt). @@ -497,6 +493,10 @@ package Scans is -- expression (incremented on entry, decremented on exit). It is used to -- disconnect format checks that normally apply to keywords THEN, ELSE etc. + Inside_Pragma : Boolean := False; + -- True within a pragma. Used to avoid complaining about reserved words + -- within pragmas (see Scan_Reserved_Identifier). + -------------------------------------------------------- -- Procedures for Saving and Restoring the Scan State -- -------------------------------------------------------- diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb index 643fde9b4c2..f5a519055a0 100644 --- a/gcc/ada/scn.adb +++ b/gcc/ada/scn.adb @@ -378,8 +378,9 @@ package body Scn is ------------------------------ procedure Scan_Reserved_Identifier (Force_Msg : Boolean) is - Token_Chars : String := Token_Type'Image (Token); + Token_Chars : String := Token_Type'Image (Token); Len : Natural := 0; + begin -- AI12-0125 : '@' denotes the target_name, i.e. serves as an -- abbreviation for the LHS of an assignment. diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 2875579fa08..ee6bcddcaf0 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3632,9 +3632,9 @@ package body Sem_Ch8 is if Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit)) and then Get_Name_String - (Unit_File_Name (Current_Sem_Unit)) (1 .. 3) /= "a-n" - and then - Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Declaration + (Unit_File_Name (Current_Sem_Unit)) (1 .. 3) /= "a-n" + and then Nkind (Unit (Cunit (Current_Sem_Unit))) = + N_Package_Declaration then Error_Msg_N ("use clause not allowed in predefined spec", N); end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index ed883731b30..144fd7d92fc 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -20517,8 +20517,9 @@ package body Sem_Util is function Should_Ignore_Pragma (Prag_Name : Name_Id) return Boolean is begin - return not Is_Internal_File_Name (File_Name (Current_Source_File)) - and then Get_Name_Table_Boolean3 (Prag_Name); + return + not Is_Internal_File_Name (File_Name (Current_Source_File)) + and then Get_Name_Table_Boolean3 (Prag_Name); end Should_Ignore_Pragma; -------------------- -- 2.30.2