[multiple changes]
2010-06-23 Jose Ruiz <ruiz@adacore.com> * a-reatim.adb, a-retide.adb: Move the initialization of the tasking run time from Ada.Real_Time.Delays to Ada.Real_Time. This way, calls to Clock (without delays) use a run time which is properly initialized. 2010-06-23 Vincent Celier <celier@adacore.com> * make.adb: Do not set Check_Readonly_Files when setting Must_Compile, when -f -u and a main is specified on the command line. However, attempt to compile even when the ALI file is read-only when Must_Compile is True. 2010-06-23 Thomas Quinot <quinot@adacore.com> * checks.adb, g-pehage.adb, cstand.adb: Minor code factorization. From-SVN: r161248
This commit is contained in:
Arnaud Charlet
parent
b4d7b435e0
commit
5b599df4d1
@ -1,3 +1,20 @@
|
||||
2010-06-23 Jose Ruiz <ruiz@adacore.com>
|
||||
|
||||
* a-reatim.adb, a-retide.adb: Move the initialization of the tasking
|
||||
run time from Ada.Real_Time.Delays to Ada.Real_Time. This way, calls to
|
||||
Clock (without delays) use a run time which is properly initialized.
|
||||
|
||||
2010-06-23 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* make.adb: Do not set Check_Readonly_Files when setting Must_Compile,
|
||||
when -f -u and a main is specified on the command line. However,
|
||||
attempt to compile even when the ALI file is read-only when
|
||||
Must_Compile is True.
|
||||
|
||||
2010-06-23 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* checks.adb, g-pehage.adb, cstand.adb: Minor code factorization.
|
||||
|
||||
2010-06-23 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Add_Internal_Interface_Entities): Generate internal
|
||||
|
||||
@ -32,7 +32,7 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with System.OS_Primitives;
|
||||
with System.Tasking;
|
||||
|
||||
package body Ada.Real_Time is
|
||||
|
||||
@ -245,5 +245,9 @@ package body Ada.Real_Time is
|
||||
end To_Time_Span;
|
||||
|
||||
begin
|
||||
System.OS_Primitives.Initialize;
|
||||
-- Ensure that the tasking run time is initialized when using clock and/or
|
||||
-- delay operations. The initialization routine has the required machinery
|
||||
-- to prevent multiple calls to Initialize.
|
||||
|
||||
System.Tasking.Initialize;
|
||||
end Ada.Real_Time;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL 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- --
|
||||
@ -75,10 +75,4 @@ package body Ada.Real_Time.Delays is
|
||||
return To_Duration (Time_Span (T));
|
||||
end To_Duration;
|
||||
|
||||
begin
|
||||
-- Ensure that the tasking run time is initialized when using delay
|
||||
-- operations. The initialization routine has the required machinery to
|
||||
-- prevent multiple calls to Initialize.
|
||||
|
||||
System.Tasking.Initialize;
|
||||
end Ada.Real_Time.Delays;
|
||||
|
||||
@ -3351,7 +3351,7 @@ package body Checks is
|
||||
Indx := Next_Index (Indx);
|
||||
end loop;
|
||||
|
||||
-- if The index type is a formal type, or derived from
|
||||
-- If the index type is a formal type or derived from
|
||||
-- one, the bounds are not static.
|
||||
|
||||
if Is_Generic_Type (Root_Type (Etype (Indx))) then
|
||||
@ -3378,8 +3378,8 @@ package body Checks is
|
||||
|
||||
-- For constrained arrays, the minimum value for
|
||||
-- Length is taken from the actual value of the
|
||||
-- bounds, since the index will be exactly of
|
||||
-- this subtype.
|
||||
-- bounds, since the index will be exactly of this
|
||||
-- subtype.
|
||||
|
||||
if Is_Constrained (Atyp) then
|
||||
Lor := UI_Max (Uint_0, UL - LU + 1);
|
||||
@ -3395,7 +3395,7 @@ package body Checks is
|
||||
end;
|
||||
|
||||
-- No special handling for other attributes
|
||||
-- Probably more opportunities exist here ???
|
||||
-- Probably more opportunities exist here???
|
||||
|
||||
when others =>
|
||||
OK1 := False;
|
||||
@ -3416,33 +3416,31 @@ package body Checks is
|
||||
Hir := No_Uint;
|
||||
end case;
|
||||
|
||||
-- At this stage, if OK1 is true, then we know that the actual
|
||||
-- result of the computed expression is in the range Lor .. Hir.
|
||||
-- We can use this to restrict the possible range of results.
|
||||
-- At this stage, if OK1 is true, then we know that the actual result of
|
||||
-- the computed expression is in the range Lor .. Hir. We can use this
|
||||
-- to restrict the possible range of results.
|
||||
|
||||
if OK1 then
|
||||
|
||||
-- If the refined value of the low bound is greater than the
|
||||
-- type high bound, then reset it to the more restrictive
|
||||
-- value. However, we do NOT do this for the case of a modular
|
||||
-- type where the possible upper bound on the value is above the
|
||||
-- base type high bound, because that means the result could wrap.
|
||||
-- If the refined value of the low bound is greater than the type
|
||||
-- high bound, then reset it to the more restrictive value. However,
|
||||
-- we do NOT do this for the case of a modular type where the
|
||||
-- possible upper bound on the value is above the base type high
|
||||
-- bound, because that means the result could wrap.
|
||||
|
||||
if Lor > Lo
|
||||
and then not (Is_Modular_Integer_Type (Typ)
|
||||
and then Hir > Hbound)
|
||||
and then not (Is_Modular_Integer_Type (Typ) and then Hir > Hbound)
|
||||
then
|
||||
Lo := Lor;
|
||||
end if;
|
||||
|
||||
-- Similarly, if the refined value of the high bound is less
|
||||
-- than the value so far, then reset it to the more restrictive
|
||||
-- value. Again, we do not do this if the refined low bound is
|
||||
-- negative for a modular type, since this would wrap.
|
||||
-- Similarly, if the refined value of the high bound is less than the
|
||||
-- value so far, then reset it to the more restrictive value. Again,
|
||||
-- we do not do this if the refined low bound is negative for a
|
||||
-- modular type, since this would wrap.
|
||||
|
||||
if Hir < Hi
|
||||
and then not (Is_Modular_Integer_Type (Typ)
|
||||
and then Lor < Uint_0)
|
||||
and then not (Is_Modular_Integer_Type (Typ) and then Lor < Uint_0)
|
||||
then
|
||||
Hi := Hir;
|
||||
end if;
|
||||
@ -3456,8 +3454,8 @@ package body Checks is
|
||||
Determine_Range_Cache_Hi (Cindex) := Hi;
|
||||
return;
|
||||
|
||||
-- If any exception occurs, it means that we have some bug in the compiler
|
||||
-- possibly triggered by a previous error, or by some unforseen peculiar
|
||||
-- If any exception occurs, it means that we have some bug in the compiler,
|
||||
-- possibly triggered by a previous error, or by some unforeseen peculiar
|
||||
-- occurrence. However, this is only an optimization attempt, so there is
|
||||
-- really no point in crashing the compiler. Instead we just decide, too
|
||||
-- bad, we can't figure out a range in this case after all.
|
||||
|
||||
@ -324,7 +324,8 @@ package body CStand is
|
||||
-- Procedure to declare given entity as an exception
|
||||
|
||||
procedure Pack_String_Type (String_Type : Entity_Id);
|
||||
-- Generate proper tree for pragma Pack that applies to given type
|
||||
-- Generate proper tree for pragma Pack that applies to given type, and
|
||||
-- mark type as having the pragma.
|
||||
|
||||
---------------------
|
||||
-- Build_Exception --
|
||||
@ -359,6 +360,7 @@ package body CStand is
|
||||
begin
|
||||
Append (Prag, Decl_S);
|
||||
Record_Rep_Item (String_Type, Prag);
|
||||
Set_Has_Pragma_Pack (String_Type, True);
|
||||
end Pack_String_Type;
|
||||
|
||||
-- Start of processing for Create_Standard
|
||||
@ -714,7 +716,6 @@ package body CStand is
|
||||
Set_Component_Size (Standard_String, Uint_8);
|
||||
Init_Size_Align (Standard_String);
|
||||
Set_Alignment (Standard_String, Uint_1);
|
||||
Set_Has_Pragma_Pack (Standard_String, True);
|
||||
Pack_String_Type (Standard_String);
|
||||
|
||||
-- On targets where a storage unit is larger than a byte (such as AAMP),
|
||||
@ -758,7 +759,6 @@ package body CStand is
|
||||
Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
|
||||
Set_Component_Size (Standard_Wide_String, Uint_16);
|
||||
Init_Size_Align (Standard_Wide_String);
|
||||
Set_Has_Pragma_Pack (Standard_Wide_String, True);
|
||||
Pack_String_Type (Standard_Wide_String);
|
||||
|
||||
-- Set index type of Wide_String
|
||||
@ -796,7 +796,6 @@ package body CStand is
|
||||
Set_Component_Size (Standard_Wide_Wide_String, Uint_32);
|
||||
Init_Size_Align (Standard_Wide_Wide_String);
|
||||
Set_Is_Ada_2005_Only (Standard_Wide_Wide_String);
|
||||
Set_Has_Pragma_Pack (Standard_Wide_Wide_String, True);
|
||||
Pack_String_Type (Standard_Wide_Wide_String);
|
||||
|
||||
-- Set index type of Wide_Wide_String
|
||||
|
||||
@ -146,7 +146,7 @@ package body GNAT.Perfect_Hash_Generators is
|
||||
-- leading spaces if required by width W.
|
||||
|
||||
function Trim_Trailing_Nuls (Str : String) return String;
|
||||
-- Return Str, but with trailing NUL characters removed.
|
||||
-- Return Str with trailing NUL characters removed
|
||||
|
||||
Output : File_Descriptor renames GNAT.OS_Lib.Standout;
|
||||
-- Shortcuts
|
||||
|
||||
@ -2448,8 +2448,8 @@ package body Make is
|
||||
-- Info on the mapping file
|
||||
|
||||
Need_To_Check_Standard_Library : Boolean :=
|
||||
Check_Readonly_Files
|
||||
and not Unique_Compile;
|
||||
(Check_Readonly_Files or Must_Compile)
|
||||
and Unique_Compile;
|
||||
|
||||
procedure Add_Process
|
||||
(Pid : Process_Id;
|
||||
@ -2905,7 +2905,7 @@ package body Make is
|
||||
|
||||
begin
|
||||
if Is_Predefined_File_Name (Fname, False) then
|
||||
if Check_Readonly_Files then
|
||||
if Check_Readonly_Files or else Must_Compile then
|
||||
Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) :=
|
||||
Comp_Args (Comp_Args'First + 1 .. Comp_Last);
|
||||
Comp_Last := Comp_Last + 1;
|
||||
@ -3103,7 +3103,7 @@ package body Make is
|
||||
if Is_Marked (Sfile, Source_Index) then
|
||||
Debug_Msg ("Skipping marked file:", Sfile);
|
||||
|
||||
elsif not Check_Readonly_Files
|
||||
elsif not (Check_Readonly_Files or Must_Compile)
|
||||
and then Is_Internal_File_Name (Sfile, False)
|
||||
then
|
||||
Debug_Msg ("Skipping internal file:", Sfile);
|
||||
@ -3283,16 +3283,15 @@ package body Make is
|
||||
Executable_Obsolete := True;
|
||||
end if;
|
||||
|
||||
In_Lib_Dir := not Check_Readonly_Files
|
||||
and then Full_Lib_File /= No_File
|
||||
and then In_Ada_Lib_Dir (Full_Lib_File);
|
||||
In_Lib_Dir := Full_Lib_File /= No_File
|
||||
and then In_Ada_Lib_Dir (Full_Lib_File);
|
||||
|
||||
-- Since the following requires a system call, we precompute it
|
||||
-- when needed.
|
||||
|
||||
if not In_Lib_Dir then
|
||||
if Full_Lib_File /= No_File
|
||||
and then not Check_Readonly_Files
|
||||
and then not (Check_Readonly_Files or else Must_Compile)
|
||||
then
|
||||
Get_Name_String (Full_Lib_File);
|
||||
Name_Buffer (Name_Len + 1) := ASCII.NUL;
|
||||
@ -3334,7 +3333,7 @@ package body Make is
|
||||
-- Source and library files can be located but are internal
|
||||
-- files.
|
||||
|
||||
elsif not Check_Readonly_Files
|
||||
elsif not (Check_Readonly_Files or else Must_Compile)
|
||||
and then Full_Lib_File /= No_File
|
||||
and then Is_Internal_File_Name (Source_File, False)
|
||||
then
|
||||
@ -5196,7 +5195,6 @@ package body Make is
|
||||
and then not Unique_Compile_All_Projects
|
||||
and then Main_On_Command_Line
|
||||
then
|
||||
Check_Readonly_Files := True;
|
||||
Must_Compile := True;
|
||||
end if;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user