aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2017-04-25 11:12:31 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2017-04-25 11:12:31 +0200
commit94d3a18d33399c807647294c973f263096fae095 (patch)
tree241695fc84fc443f47ea6b65207c576a7bea745b /gcc/ada
parent51148ddab1495aa357e57f1c209940f7cde571c1 (diff)
downloadgcc-94d3a18d33399c807647294c973f263096fae095.zip
gcc-94d3a18d33399c807647294c973f263096fae095.tar.gz
gcc-94d3a18d33399c807647294c973f263096fae095.tar.bz2
[multiple changes]
2017-04-25 Hristian Kirtchev <kirtchev@adacore.com> * 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 <obry@adacore.com> * s-taprop-mingw.adb: Do not check for CloseHandle in Finalize_TCB. From-SVN: r247153
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog10
-rw-r--r--gcc/ada/fname.adb84
-rw-r--r--gcc/ada/make.adb2
-rw-r--r--gcc/ada/osint.adb4
-rw-r--r--gcc/ada/par-ch2.adb48
-rw-r--r--gcc/ada/s-taprop-mingw.adb6
-rw-r--r--gcc/ada/scans.ads8
-rw-r--r--gcc/ada/scn.adb3
-rw-r--r--gcc/ada/sem_ch8.adb6
-rw-r--r--gcc/ada/sem_util.adb5
10 files changed, 112 insertions, 64 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 917785a..23ba472 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,15 @@
2017-04-25 Hristian Kirtchev <kirtchev@adacore.com>
+ * 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 <obry@adacore.com>
+
+ * s-taprop-mingw.adb: Do not check for CloseHandle in
+ Finalize_TCB.
+
+2017-04-25 Hristian Kirtchev <kirtchev@adacore.com>
+
* sem_util.adb (Check_Part_Of_Reference):
Continue to examine the context if the reference appears within
an expression function.
diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb
index 9ee2e9a..5905dfb 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 bfdd216..d6ea05b 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 d5f6307..2a3b1c3 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 cd79ac3..fc8d9cb 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 aba2367..e3d0842 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 a8972be..428c1a5 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 643fde9..f5a5190 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 2875579..ee6bcdd 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 ed88373..144fd7d 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;
--------------------