+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
(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);
-- --
-- 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- --
-------------------
-- 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
-- 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;
-------------------
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;
-- 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
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;
projects / platform / upstream / gcc.git / commitdiff