gnatlink.adb (Gnatlink): Check for suspicious executable file names on windows.

2014-01-23  Robert Dewar  <dewar@adacore.com>

	* gnatlink.adb (Gnatlink): Check for suspicious executable file
	names on windows.

2014-01-23  Robert Dewar  <dewar@adacore.com>

	* a-ngelfu.ads: Remove bad uses of AND which should be AND THEN.
	* sem_res.adb (Check_No_Direct_Boolean_Operators): Don't give
	style errors in instances.
	* g-dynhta.ads (Static_HTable): Comment updates.

From-SVN: r206986

5 files changed, 82 insertions, 18 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 556cc9d..ee7e846 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2014-01-23  Robert Dewar  <dewar@adacore.com>
+
+	* gnatlink.adb (Gnatlink): Check for suspicious executable file
+	names on windows.
+
+2014-01-23  Robert Dewar  <dewar@adacore.com>
+
+	* a-ngelfu.ads: Remove bad uses of AND which should be AND THEN.
+	* sem_res.adb (Check_No_Direct_Boolean_Operators): Don't give
+	style errors in instances.
+	* g-dynhta.ads (Static_HTable): Comment updates.
+
 2014-01-23  Vincent Celier  <celier@adacore.com>
 
 	* prj-conf.adb (Get_Or_Create_Configuration_File): Do not attempt
diff --git a/gcc/ada/a-ngelfu.ads b/gcc/ada/a-ngelfu.ads
index 91e1cf7..0d55101 100644
--- a/gcc/ada/a-ngelfu.ads
+++ b/gcc/ada/a-ngelfu.ads
@@ -103,27 +103,27 @@ package Ada.Numerics.Generic_Elementary_Functions is
      (Y : Float_Type'Base;
       X : Float_Type'Base := 1.0) return Float_Type'Base
    with
-     Post => (if X > 0.0 and Y = 0.0 then Arctan'Result = 0.0);
+     Post => (if X > 0.0 and then Y = 0.0 then Arctan'Result = 0.0);
 
    function Arctan
      (Y     : Float_Type'Base;
       X     : Float_Type'Base := 1.0;
       Cycle : Float_Type'Base) return Float_Type'Base
    with
-     Post => (if X > 0.0 and Y = 0.0 then Arctan'Result = 0.0);
+     Post => (if X > 0.0 and then Y = 0.0 then Arctan'Result = 0.0);
 
    function Arccot
      (X   : Float_Type'Base;
       Y   : Float_Type'Base := 1.0) return Float_Type'Base
    with
-     Post => (if X > 0.0 and Y = 0.0 then Arccot'Result = 0.0);
+     Post => (if X > 0.0 and then Y = 0.0 then Arccot'Result = 0.0);
 
    function Arccot
      (X     : Float_Type'Base;
       Y     : Float_Type'Base := 1.0;
       Cycle : Float_Type'Base) return Float_Type'Base
    with
-     Post => (if X > 0.0 and Y = 0.0 then Arccot'Result = 0.0);
+     Post => (if X > 0.0 and then Y = 0.0 then Arccot'Result = 0.0);
 
    function Sinh (X : Float_Type'Base) return Float_Type'Base with
      Post => (if X = 0.0 then Sinh'Result = 0.0);
diff --git a/gcc/ada/g-dynhta.ads b/gcc/ada/g-dynhta.ads
index 4c238af..1369244 100644
--- a/gcc/ada/g-dynhta.ads
+++ b/gcc/ada/g-dynhta.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 1995-2010, AdaCore                     --
+--                     Copyright (C) 1995-2013, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -54,12 +54,11 @@ package GNAT.Dynamic_HTables is
    -------------------
 
    --  A low-level Hash-Table abstraction, not as easy to instantiate as
-   --  Simple_HTable but designed to allow complete control over the
-   --  allocation of necessary data structures. Particularly useful when
-   --  dynamic allocation is not desired. The model is that each Element
-   --  contains its own Key that can be retrieved by Get_Key. Furthermore,
-   --  Element provides a link that can be used by the HTable for linking
-   --  elements with same hash codes:
+   --  Simple_HTable. This mirrors the interface of GNAT.HTable.Static_HTable,
+   --  but does require dynamic allocation (since we allow multiple instances
+   --  of the table. The model is that each Element contains its own Key that
+   --  can be retrieved by Get_Key. Furthermore, Element provides a link that
+   --  can be used by the HTable for linking elements with same hash codes:
 
    --       Element
 
@@ -133,11 +132,9 @@ package GNAT.Dynamic_HTables is
       --  elements of the Htable will be traversed.
 
    private
-
       type Instance_Data;
       type Instance is access all Instance_Data;
       Nil : constant Instance := null;
-
    end Static_HTable;
 
    -------------------
diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb
index 68262f4..1746bcd 100644
--- a/gcc/ada/gnatlink.adb
+++ b/gcc/ada/gnatlink.adb
@@ -294,8 +294,9 @@ procedure Gnatlink is
       for J in Units.Table'First .. Units.Last loop
          Sfile := Units.Table (J).Sfile;
          if Sfile = Efile then
-            Exit_With_Error ("executable name """ & File_Name & """ matches "
-              & "source file name """ & Get_Name_String (Sfile) & """");
+            Exit_With_Error
+              ("executable name """ & File_Name & """ matches "
+               & "source file name """ & Get_Name_String (Sfile) & """");
          end if;
       end loop;
 
@@ -1779,15 +1780,65 @@ begin
    --  on Unix. On non-Unix systems executables have a suffix, so the warning
    --  will not appear. However, do not warn in the case of a cross compiler.
 
-   --  Assume this is a cross tool if the executable name is not gnatlink
+   --  Assume this is a cross tool if the executable name is not gnatlink.
+   --  Note that the executable name is also gnatlink on windows, but in that
+   --  case the output file name will be test.exe rather than test.
 
    if Base_Command_Name.all = "gnatlink"
      and then Output_File_Name.all = "test"
    then
       Error_Msg ("warning: executable name """ & Output_File_Name.all
-                   & """ may conflict with shell command");
+                 & """ may conflict with shell command");
    end if;
 
+   --  Special warnings for worrisome file names on windows
+
+   --  Windows-7 will not allow an executable file whose name contains any
+   --  of the substrings "install", "setup", or "update" to load without
+   --  special administration privileges. This rather incredible behavior
+   --  is Microsoft's idea of a useful security precaution.
+
+   Bad_File_Names_On_Windows : declare
+      FN : String := Output_File_Name.all;
+
+      procedure Check_File_Name (S : String);
+      --  Warn if file name has the substring S
+
+      procedure Check_File_Name (S : String) is
+      begin
+         for J in 1 .. FN'Length - (S'Length - 1) loop
+            if FN (J .. J + (S'Length - 1)) = S then
+               Error_Msg
+                 ("warning: possible problem with executable name """
+                  & Output_File_Name.all & '"');
+               Error_Msg
+                 ("file name contains substring """ & S & '"');
+               Error_Msg
+                 ("admin privileges may be required on Windows 7 "
+                  & "to load this file");
+            end if;
+         end loop;
+      end Check_File_Name;
+
+   --  Start of processing for Bad_File_Names_On_Windows
+
+   begin
+      for J in FN'Range loop
+            FN (J) := Csets.Fold_Lower (FN (J));
+      end loop;
+
+      --  For now we detect windows by an output executable name ending with
+      --  the suffix .exe (excluding VMS which might use that same name).
+
+      if FN'Length > 5
+        and then FN (FN'Last - 3 .. FN'Last) = ".exe"
+      then
+         Check_File_Name ("install");
+         Check_File_Name ("setup");
+         Check_File_Name ("update");
+      end if;
+   end Bad_File_Names_On_Windows;
+
    --  If -M switch was specified, add the switches to create the map file
 
    if Create_Map_File then
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 0aa6690..7308364 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -976,8 +976,12 @@ package body Sem_Res is
          end if;
       end if;
 
+      --  Do style check (but skip if in instance, error is on template)
+
       if Style_Check then
-         Check_Boolean_Operator (N);
+         if not In_Instance then
+            Check_Boolean_Operator (N);
+         end if;
       end if;
    end Check_No_Direct_Boolean_Operators;