+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
-- --
------------------------------------------------------------------------------
-with System.OS_Primitives;
+with System.Tasking;
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;
-- --
-- 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- --
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;
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
-- 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);
end;
-- No special handling for other attributes
- -- Probably more opportunities exist here ???
+ -- Probably more opportunities exist here???
when others =>
OK1 := False;
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;
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.
-- 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 --
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
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),
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
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
-- 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
-- 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;
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;
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);
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;
-- 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
and then not Unique_Compile_All_Projects
and then Main_On_Command_Line
then
- Check_Readonly_Files := True;
Must_Compile := True;
end if;
projects / gcc.git / commitdiff