[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 25 Apr 2017 09:12:31 +0000 (11:12 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 25 Apr 2017 09:12:31 +0000 (11:12 +0200)
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

gcc/ada/ChangeLog
gcc/ada/fname.adb
gcc/ada/make.adb
gcc/ada/osint.adb
gcc/ada/par-ch2.adb
gcc/ada/s-taprop-mingw.adb
gcc/ada/scans.ads
gcc/ada/scn.adb
gcc/ada/sem_ch8.adb
gcc/ada/sem_util.adb

index 917785a5bfa69bf28976ce80ed1bda183e076152..23ba472288127c7704afc1eb164132d607abc480 100644 (file)
@@ -1,3 +1,13 @@
+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):
index 9ee2e9a936c1302d56fb523dd7c05593f8320db1..5905dfb9b39f9e9fe7226b53f7d48fb641258814 100644 (file)
@@ -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;
 
    ---------------
index bfdd2163f41236c130120299c56ab5febdbfd678..d6ea05bd5f19fdd703e048711018ba206c3e11f9 100644 (file)
@@ -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) :=
index d5f63075fa8bf670158c3e6000b0afb16d0ea0cd..2a3b1c3dbcae568de322cf578284f22082b8ea6b 100644 (file)
@@ -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;
 
index cd79ac3de293a78919ac465b403483d0666fd302..fc8d9cbd72174073d1d525f2f8862a14280897e0 100644 (file)
@@ -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;
 
index aba2367310d0c3c7b6fb07a578366c8971e19d03..e3d0842953ce53c85091b6874c4f39daa22efe49 100644 (file)
@@ -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);
index a8972bed4f53e0de06d8f4d9d09d22abb64e1c4c..428c1a5b9750891a76cdef0816b8d9f125125805 100644 (file)
@@ -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 --
    --------------------------------------------------------
index 643fde9b4c20866e1cda86ff5464d74a431e238d..f5a519055a0b958fbb725a60996311bd6e9c3068 100644 (file)
@@ -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.
index 2875579fa088e523aebec6f660a492d5fda7250e..ee6bcddcaf01f80e1539c6502d717bd9b3d707ee 100644 (file)
@@ -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;
index ed883731b303351e5675beb14617db3aeb7c5a2b..144fd7d92fc6fe22011d990d4caf4075f50c20fc 100644 (file)
@@ -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;
 
    --------------------