From 457cee0b8470f50b68638f433f480cbbebddef51 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 12:52:13 +0200 Subject: [PATCH] [multiple changes] 2017-04-25 Eric Botcazou * fname.adb (Is_Internal_File_Name): Arrange for the slices to have a length which is a power of 2. (Is_Predefined_File_Name): Likewise. Adjust comment. 2017-04-25 Bob Duff * exp_aggr.adb (Component_Count): Protect the arithmetic from attempting to convert a value >= 2**31 to Int, which would otherwise raise Constraint_Error. 2017-04-25 Bob Duff * opt.ads (Locking_Policy): Fix incorrect documentation. The first character of the policy name is not unique. 2017-04-25 Bob Duff * s-fileio.adb (Name): Raise Use_Error if the file is a temp file. * s-ficobl.ads (Is_Temporary_File): Remove incorrect comment about this flag not being used. It was already used, and it is now used more. From-SVN: r247183 --- gcc/ada/ChangeLog | 24 ++++++++++++++++++++++++ gcc/ada/exp_aggr.adb | 18 +++++++++++++++--- gcc/ada/fname.adb | 21 ++++++++++++++++----- gcc/ada/opt.ads | 9 ++++++--- gcc/ada/s-ficobl.ads | 5 +---- gcc/ada/s-fileio.adb | 2 ++ 6 files changed, 64 insertions(+), 15 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bec26bcc770..cc1403c0226 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2017-04-25 Eric Botcazou + + * fname.adb (Is_Internal_File_Name): Arrange for the slices to + have a length which is a power of 2. + (Is_Predefined_File_Name): Likewise. Adjust comment. + +2017-04-25 Bob Duff + + * exp_aggr.adb (Component_Count): Protect the + arithmetic from attempting to convert a value >= 2**31 to Int, + which would otherwise raise Constraint_Error. + +2017-04-25 Bob Duff + + * opt.ads (Locking_Policy): Fix incorrect documentation. The + first character of the policy name is not unique. + +2017-04-25 Bob Duff + + * s-fileio.adb (Name): Raise Use_Error if the file is a temp file. + * s-ficobl.ads (Is_Temporary_File): Remove incorrect comment + about this flag not being used. It was already used, and it is + now used more. + 2017-04-25 Hristian Kirtchev * einfo.adb Flag301 is now known as Ignore_SPARK_Mode_Pragmas. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 7e03e4ed640..685edaafa72 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -352,7 +352,7 @@ package body Exp_Aggr is -- which hit memory limits in the backend. function Component_Count (T : Entity_Id) return Nat; - -- The limit is applied to the total number of components that the + -- The limit is applied to the total number of subcomponents that the -- aggregate will have, which is the number of static expressions -- that will appear in the flattened array. This requires a recursive -- computation of the number of scalar components of the structure. @@ -399,8 +399,20 @@ package body Exp_Aggr is return 0; else - return - Siz * UI_To_Int (Expr_Value (Hi) - Expr_Value (Lo) + 1); + -- If the number of components is greater than Int'Last, + -- then return Int'Last, so caller will return False (Aggr + -- size is not OK). Otherwise, UI_To_Int will crash. + + declare + UI : constant Uint := + Expr_Value (Hi) - Expr_Value (Lo) + 1; + begin + if UI_Is_In_Int_Range (UI) then + return Siz * UI_To_Int (UI); + else + return Int'Last; + end if; + end; end if; end; diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb index 0487085e02c..c75048bb63a 100644 --- a/gcc/ada/fname.adb +++ b/gcc/ada/fname.adb @@ -119,7 +119,15 @@ package body Fname is return False; end if; - return Has_Prefix (Fname, "g-") or else Has_Prefix (Fname, "gnat."); + -- Definitely internal if prefix is g- + + if Has_Prefix (Fname, "g-") then + return True; + end if; + + -- See the note in Is_Predefined_File_Name for the rationale + + return Fname'Length = 8 and then Has_Prefix (Fname, "gnat"); end Is_Internal_File_Name; function Is_Internal_File_Name @@ -154,9 +162,12 @@ package body Fname is "text_io."); -- Text_IO -- Note: the implementation is optimized to perform uniform comparisons - -- on string slices whose length is known at compile time and at most 8 - -- characters; the remaining calls to Has_Prefix must be inlined so as - -- to expose the compile-time known length. + -- on string slices whose length is known at compile time and is a small + -- power of 2 (at most 8 characters); the remaining calls to Has_Prefix + -- must be inlined to expose the compile-time known length. There must + -- be no calls to the fallback string comparison routine (e.g. memcmp) + -- left in the object code for the function; this can save up to 10% of + -- the entire compilation time spent in the front end. begin if not Has_Internal_Extension (Fname) then @@ -187,7 +198,7 @@ package body Fname is if Has_Prefix (Fname, "ada.") -- Ada or else Has_Prefix (Fname, "interfac") -- Interfaces - or else Has_Prefix (Fname, "system.") -- System + or else Has_Prefix (Fname, "system.a") -- System then return True; end if; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index bb6c5b37e13..94be519e297 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1021,9 +1021,12 @@ package Opt is Locking_Policy : Character := ' '; -- GNAT, GNATBIND - -- Set to ' ' for the default case (no locking policy specified). Reset to - -- first character (uppercase) of locking policy name if a valid pragma - -- Locking_Policy is encountered. + + -- Set to ' ' for the default case (no locking policy specified). Otherwise + -- set based on the pragma Locking_Policy: + -- Ceiling_Locking: 'C' + -- Concurrent_Readers_Locking: 'R' + -- Inheritance_Locking: 'I' Locking_Policy_Sloc : Source_Ptr := No_Location; -- GNAT, GNATBIND diff --git a/gcc/ada/s-ficobl.ads b/gcc/ada/s-ficobl.ads index a95c0392419..a3b4bcf3120 100644 --- a/gcc/ada/s-ficobl.ads +++ b/gcc/ada/s-ficobl.ads @@ -108,10 +108,7 @@ package System.File_Control_Block is Is_Temporary_File : Boolean; -- A flag set only for temporary files (i.e. files created using the - -- Create function with a null name parameter, using tmpfile). This - -- is currently not used since temporary files are deleted by the - -- operating system, but it is set properly in case some systems - -- need this information in the future. + -- Create function with a null name parameter). Is_System_File : Boolean; -- A flag set only for system files (stdin, stdout, stderr) diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index 870350c9503..fdc99278cee 100644 --- a/gcc/ada/s-fileio.adb +++ b/gcc/ada/s-fileio.adb @@ -744,6 +744,8 @@ package body System.File_IO is begin if File = null then raise Status_Error with "Name: file not open"; + elsif File.Is_Temporary_File then + raise Use_Error with "Name: temporary file has no name"; else return File.Name.all (1 .. File.Name'Length - 1); end if; -- 2.30.2