Commit 457cee0b by Arnaud Charlet

[multiple changes]

2017-04-25  Eric Botcazou  <ebotcazou@adacore.com>

	* 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  <duff@adacore.com>

	* 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  <duff@adacore.com>

	* opt.ads (Locking_Policy): Fix incorrect documentation. The
	first character of the policy name is not unique.

2017-04-25  Bob Duff  <duff@adacore.com>

	* 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
parent cf9a473e
2017-04-25 Eric Botcazou <ebotcazou@adacore.com>
* 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 <duff@adacore.com>
* 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 <duff@adacore.com>
* opt.ads (Locking_Policy): Fix incorrect documentation. The
first character of the policy name is not unique.
2017-04-25 Bob Duff <duff@adacore.com>
* 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 <kirtchev@adacore.com>
* einfo.adb Flag301 is now known as Ignore_SPARK_Mode_Pragmas.
......
......@@ -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;
......
......@@ -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;
......
......@@ -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
......
......@@ -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)
......
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment