+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.
-- 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.
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;
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
"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
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;
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
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)
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;