From 545d3e65ad4b45dc1ad7991a18e99b755ce9cbbf Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Thu, 23 Jan 2014 16:53:34 +0000 Subject: [PATCH] gnatlink.adb (Gnatlink): Check for suspicious executable file names on windows. 2014-01-23 Robert Dewar * gnatlink.adb (Gnatlink): Check for suspicious executable file names on windows. 2014-01-23 Robert Dewar * 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 --- gcc/ada/ChangeLog | 12 +++++++++++ gcc/ada/a-ngelfu.ads | 8 +++---- gcc/ada/g-dynhta.ads | 15 ++++++------- gcc/ada/gnatlink.adb | 59 ++++++++++++++++++++++++++++++++++++++++++++++++---- gcc/ada/sem_res.adb | 6 +++++- 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 + + * gnatlink.adb (Gnatlink): Check for suspicious executable file + names on windows. + +2014-01-23 Robert Dewar + + * 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 * 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; -- 2.7.4