[Ada] Various code clean-ups from CodePeer messages

2018-07-31  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* clean.adb, gnatchop.adb, gnatfind.adb, gnatls.adb,
	gnatmake.ads, gnatxref.adb, make.adb, make.ads, make_util.ads,
	sfn_scan.adb, vxaddr2line.adb, xeinfo.adb, xoscons.adb,
	xr_tabls.adb, xref_lib.adb: Address CodePeer messages.

From-SVN: r263108

gcc/ada/ChangeLog

 2018-07-31  Arnaud Charlet  <charlet@adacore.com>
 
+	* clean.adb, gnatchop.adb, gnatfind.adb, gnatls.adb,
+	gnatmake.ads, gnatxref.adb, make.adb, make.ads, make_util.ads,
+	sfn_scan.adb, vxaddr2line.adb, xeinfo.adb, xoscons.adb,
+	xr_tabls.adb, xref_lib.adb: Address CodePeer messages.
+
+2018-07-31  Arnaud Charlet  <charlet@adacore.com>
+
 	* gnatlink.adb: Fix potential Constraint_Error if
 	Library_Version is too long.
 

gcc/ada/clean.adb

@@ -694,6 +694,7 @@ package body Clean is
             Arg : constant String := Argument (Index);
 
             procedure Bad_Argument;
+            pragma No_Return (Bad_Argument);
             --  Signal bad argument
 
             ------------------

gcc/ada/gnatchop.adb

@@ -599,7 +599,7 @@ procedure Gnatchop is
       Chop_Name   : constant String_Access   := File.Table (Num).Name;
       Save_Stdout : constant File_Descriptor := dup (Standout);
       Offset_Name : Temp_File_Name;
-      Offset_FD   : File_Descriptor;
+      Offset_FD   : File_Descriptor := Invalid_FD;
       Buffer      : String_Access;
       Success     : Boolean;
       Failure     : exception;
@@ -685,10 +685,12 @@ procedure Gnatchop is
 
    exception
       when Failure | Types.Terminate_Program =>
-         Close (Offset_FD);
+         if Offset_FD /= Invalid_FD then
+            Close (Offset_FD);
+         end if;
+
          Delete_File (Offset_Name'Address, Success);
          return False;
-
    end Parse_File;
 
    -----------------------

gcc/ada/gnatfind.adb

@@ -75,6 +75,7 @@ procedure Gnatfind is
    --  Display the usage
 
    procedure Write_Usage;
+   pragma No_Return (Write_Usage);
    --  Print a small help page for program usage and exit program
 
    --------------------

gcc/ada/gnatls.adb

@@ -187,6 +187,7 @@ procedure Gnatls is
    --  Print usage message
 
    procedure Output_License_Information;
+   pragma No_Return (Output_License_Information);
    --  Output license statement, and if not found, output reference to COPYING
 
    function Image (Restriction : Restriction_Id) return String;
@@ -694,40 +695,38 @@ procedure Gnatls is
 
       procedure Output_Token (T : Token_Type) is
       begin
-         if T in T_No_ALI .. T_Flags then
-            for J in 1 .. N_Indents loop
-               Write_Str ("   ");
-            end loop;
+         case T is
+            when T_No_ALI .. T_Flags =>
+               for J in 1 .. N_Indents loop
+                  Write_Str ("   ");
+               end loop;
 
-            Write_Str (Image (T).all);
+               Write_Str (Image (T).all);
 
-            for J in Image (T)'Length .. 12 loop
-               Write_Char (' ');
-            end loop;
+               for J in Image (T)'Length .. 12 loop
+                  Write_Char (' ');
+               end loop;
 
-            Write_Str ("=>");
+               Write_Str ("=>");
 
-            if T in T_No_ALI .. T_With then
-               Write_Eol;
-            elsif T in T_Source .. T_Name then
-               Write_Char (' ');
-            end if;
-
-         elsif T in T_Preelaborated .. T_Body then
-            if T in T_Preelaborated .. T_Is_Generic then
-               if N_Flags = 0 then
-                  Output_Token (T_Flags);
+               if T in T_No_ALI .. T_With then
+                  Write_Eol;
+               elsif T in T_Source .. T_Name then
+                  Write_Char (' ');
                end if;
 
-               N_Flags := N_Flags + 1;
-            end if;
+            when T_Preelaborated .. T_Body =>
+               if T in T_Preelaborated .. T_Is_Generic then
+                  if N_Flags = 0 then
+                     Output_Token (T_Flags);
+                  end if;
 
-            Write_Char (' ');
-            Write_Str  (Image (T).all);
+                  N_Flags := N_Flags + 1;
+               end if;
 
-         else
-            Write_Str  (Image (T).all);
-         end if;
+               Write_Char (' ');
+               Write_Str  (Image (T).all);
+         end case;
       end Output_Token;
 
       -----------------

gcc/ada/gnatmake.ads

@@ -24,6 +24,7 @@
 ------------------------------------------------------------------------------
 
 procedure Gnatmake;
+pragma No_Return (Gnatmake);
 --  The driver for the gnatmake tool. This utility can be used to automatically
 --  (re)compile a set of ada sources by giving the name of the root compilation
 --  unit or the source file containing it. For more information on gnatmake

gcc/ada/gnatxref.adb

@@ -63,6 +63,7 @@ procedure Gnatxref is
    --  Display the usage
 
    procedure Write_Usage;
+   pragma No_Return (Write_Usage);
    --  Print a small help page for program usage
 
    --------------------

gcc/ada/make.adb

@@ -85,6 +85,7 @@ package body Make is
 
    procedure Sigint_Intercepted;
    pragma Convention (C, Sigint_Intercepted);
+   pragma No_Return (Sigint_Intercepted);
    --  Called when the program is interrupted by Ctrl-C to delete the
    --  temporary mapping files and configuration pragmas files.
 
@@ -254,6 +255,7 @@ package body Make is
                                No_Shared_Libgcc_Switch'Access;
 
    procedure Make_Failed (S : String);
+   pragma No_Return (Make_Failed);
    --  Delete all temp files created by Gnatmake and call Osint.Fail, with the
    --  parameter S (see osint.ads).
 
@@ -545,6 +547,7 @@ package body Make is
    --  Display_Executed_Programs is set. The lower bound of Args must be 1.
 
    procedure Report_Compilation_Failed;
+   pragma No_Return (Report_Compilation_Failed);
    --  Delete all temporary files and fail graciously
 
    -----------------
@@ -580,7 +583,7 @@ package body Make is
    Gnatmake_Mapping_File : String_Access := null;
    --  The path name of a mapping file specified by switch -C=
 
-   procedure Init_Mapping_File (File_Index : in out Natural);
+   procedure Init_Mapping_File (File_Index : out Natural);
    --  Create a new mapping file or reuse one already created.
 
    package Temp_File_Paths is new Table.Table
@@ -2347,10 +2350,10 @@ package body Make is
          Full_Lib_File : File_Name_Type := No_File;
          Lib_File_Attr : aliased File_Attributes;
          Read_Only     : Boolean := False;
-         ALI           : ALI_Id;
+         ALI           : ALI_Id := No_ALI_Id;
          --  The ALI file and its attributes (size, stamp, ...)
 
-         Obj_File  : File_Name_Type;
+         Obj_File  : File_Name_Type := No_File;
          Obj_Stamp : Time_Stamp_Type;
          --  The object file
 
@@ -3614,7 +3617,7 @@ package body Make is
    -- Init_Mapping_File --
    -----------------------
 
-   procedure Init_Mapping_File (File_Index : in out Natural) is
+   procedure Init_Mapping_File (File_Index : out Natural) is
       FD     : File_Descriptor;
       Status : Boolean;
       --  For call to Close
@@ -4378,9 +4381,7 @@ package body Make is
                Look_In_Primary_Dir := False;
 
             elsif Program_Args = Compiler then
-               if Argv (3 .. Argv'Last) /= "-" then
-                  Add_Source_Search_Dir (Argv (3 .. Argv'Last));
-               end if;
+               Add_Source_Search_Dir (Argv (3 .. Argv'Last));
 
             elsif Program_Args = Binder then
                Add_Library_Search_Dir (Argv (3 .. Argv'Last));
@@ -4690,7 +4691,8 @@ package body Make is
 
          --  -m
 
-         elsif Argv (2) = 'm' and then Argv'Last = 2 then
+         elsif Argv (2) = 'm' then
+            pragma Assert (Argv'Last = 2);
             Minimal_Recompilation := True;
 
          --  -u

gcc/ada/make.ads

@@ -29,6 +29,7 @@
 package Make is
 
    procedure Gnatmake;
+   pragma No_Return (Gnatmake);
    --  The driver of gnatmake. For more information on gnatmake and its
    --  precise usage please refer to the gnat documentation.
 

gcc/ada/make_util.ads

@@ -184,11 +184,13 @@ package Make_Util is
    procedure Fail_Program
      (S              : String;
       Flush_Messages : Boolean := True);
+   pragma No_Return (Fail_Program);
    --  Terminate program with a message and a fatal status code
 
    procedure Finish_Program
      (Exit_Code    : Osint.Exit_Code_Type := Osint.E_Success;
       S            : String := "");
+   pragma No_Return (Finish_Program);
    --  Terminate program, with or without a message, setting the status code
    --  according to Fatal. This properly removes all temporary files.
 

gcc/ada/sfn_scan.adb

@@ -106,6 +106,7 @@ package body SFN_Scan is
    --  ('a' .. 'z').
 
    procedure Error (Err : String);
+   pragma No_Return (Error);
    --  Called if an error is detected. Raises Syntax_Error_In_GNAT_ADC
    --  with a message of the form gnat.adc:line:col: xxx, where xxx is
    --  the string Err passed as a parameter.

gcc/ada/vxaddr2line.adb

@@ -209,6 +209,7 @@ procedure VxAddr2Line is
    --  Prints the message and then terminates the program
 
    procedure Usage;
+   pragma No_Return (Usage);
    --  Displays the short help message and then terminates the program
 
    function Get_Reference_Offset return Unsigned_64;
@@ -319,7 +320,7 @@ procedure VxAddr2Line is
       declare
          Match_String : constant String := Expect_Out_Match (Pd);
          Matches      : Match_Array (0 .. 1);
-         Value        : Unsigned_64;
+         Value        : Unsigned_64 := 0;
 
       begin
          Match (Reference, Match_String, Matches);

gcc/ada/xeinfo.adb

@@ -151,6 +151,7 @@ procedure XEinfo is
    Lastinlined : Boolean;
 
    procedure Badfunc;
+   pragma No_Return (Badfunc);
    --  Signal bad function in body
 
    function Getlin return VString;

gcc/ada/xoscons.adb

@@ -166,7 +166,7 @@ procedure XOSCons is
       A2 : Long_Unsigned renames V2.Abs_Value;
    begin
       return (P1 and then not P2)
-        or else (P1 and then P2 and then A1 > A2)
+        or else (P1 and then A1 > A2)
         or else (not P1 and then not P2 and then A1 < A2);
    end ">";
 

gcc/ada/xr_tabls.adb

@@ -761,6 +761,9 @@ package body Xr_Tabls is
       With_Dir : Boolean := False;
       Strip    : Natural    := 0) return String
    is
+      pragma Annotate (CodePeer, Skip_Analysis);
+      --  ??? To disable false positives currently generated
+
       Tmp : GNAT.OS_Lib.String_Access;
 
       function Internal_Strip (Full_Name : String) return String;

gcc/ada/xref_lib.adb

@@ -75,7 +75,7 @@ package body Xref_Lib is
 
    procedure Open
      (Name         : String;
-      File         : out ALI_File;
+      File         : in out ALI_File;
       Dependencies : Boolean := False);
    --  Open a new ALI file. If Dependencies is True, the insert every library
    --  file 'with'ed in the files database (used for gnatxref)
@@ -688,7 +688,7 @@ package body Xref_Lib is
 
    procedure Open
      (Name         : String;
-      File         : out ALI_File;
+      File         : in out ALI_File;
       Dependencies : Boolean := False)
    is
       Ali : String_Access renames File.Buffer;