+2014-08-04 Doug Rupp <rupp@adacore.com>
+
+ * g-calend.adb (timeval_to_duration, duration_to_timeval): Change sec
+ formal to long_long.
+ * g-calend.ads (timeval): Bump up size to accomodate sec type.
+ * s-taprop-linux.adb (timeval_to_duration): Change sec formal to
+ long_long
+ * s-osprim-posix.adb (timeval): Bump up size to accomodate
+ new sec type.
+ (timeval_to_duration): Change sec formal to Long_Long_Integer
+ * s-osinte-darwin.adb (timeval): Bump up
+ size to accomodate new sec type.
+ (timeval_to_duration): Change sec formal to long_long
+ * s-osinte-android.adb: Likewise.
+ * cal.c (__gnat_timeal_to_duration, __gnat_duration_to_timeval): Change
+ sec formal from long to long long.
+
+2014-08-04 Robert Dewar <dewar@adacore.com>
+
+ * sem_res.adb (Resolve_Qualified_Expression): Make sure
+ Do_Range_Check flag gets set.
+
2014-08-04 Robert Dewar <dewar@adacore.com>
* einfo.ads, einfo.adb (Is_Standard_String_Type): New function.
#endif
void
-__gnat_timeval_to_duration (struct timeval *t, long *sec, long *usec)
+__gnat_timeval_to_duration (struct timeval *t, long long *sec, long *usec)
{
- *sec = (long) t->tv_sec;
+ *sec = (long long) t->tv_sec;
*usec = (long) t->tv_usec;
}
void
-__gnat_duration_to_timeval (long sec, long usec, struct timeval *t)
+__gnat_duration_to_timeval (long long sec, long usec, struct timeval *t)
{
- /* here we are doing implicit conversion from a long to the struct timeval
+ /* here we are doing implicit conversion to the struct timeval
fields types. */
t->tv_sec = sec;
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2012, AdaCore --
+-- Copyright (C) 1999-2014, AdaCore --
-- --
-- GNAT 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- --
-- --
------------------------------------------------------------------------------
-package body GNAT.Calendar is
+with Interfaces.C.Extensions;
+package body GNAT.Calendar is
use Ada.Calendar;
use Interfaces;
procedure timeval_to_duration
(T : not null access timeval;
- sec : not null access C.long;
+ sec : not null access C.Extensions.long_long;
usec : not null access C.long);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6;
- sec : aliased C.long;
+ sec : aliased C.Extensions.long_long;
usec : aliased C.long;
begin
function To_Timeval (D : Duration) return timeval is
procedure duration_to_timeval
- (Sec : C.long;
+ (Sec : C.Extensions.long_long;
Usec : C.long;
T : not null access timeval);
pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval");
Micro : constant := 10**6;
Result : aliased timeval;
- sec : C.long;
+ sec : C.Extensions.long_long;
usec : C.long;
begin
sec := 0;
usec := 0;
else
- sec := C.long (D - 0.5);
+ sec := C.Extensions.long_long (D - 0.5);
usec := C.long ((D - Duration (sec)) * Micro - 0.5);
end if;
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2014, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
-- This is a dummy declaration that should be the largest possible timeval
-- structure of all supported targets.
- type timeval is array (1 .. 2) of Interfaces.C.long;
+ type timeval is array (1 .. 3) of Interfaces.C.long;
function Julian_Day
(Year : Ada.Calendar.Year_Number;
-- --
-- B o d y --
-- --
--- Copyright (C) 1995-2012, AdaCore --
+-- Copyright (C) 1995-2014, AdaCore --
-- --
-- GNAT 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- --
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-with Interfaces.C; use Interfaces.C;
+with Interfaces.C; use Interfaces.C;
+with Interfaces.C.Extentions; use Interfaces.C.Extentions;
+
package body System.OS_Interface is
-----------------
use Interfaces;
- type timeval is array (1 .. 2) of C.long;
+ type timeval is array (1 .. 3) of C.long;
+ -- The timeval array is sized to contain long_long sec and long usec.
+ -- If long_long'Size = long'Size then it will be overly large but that
+ -- won't effect the implementation since it's not accessed directly.
procedure timeval_to_duration
(T : not null access timeval;
- sec : not null access C.long;
+ sec : not null access C.Extensions.long_long;
usec : not null access C.long);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6;
- sec : aliased C.long;
+ sec : aliased C.Extensions.long_long;
usec : aliased C.long;
TV : aliased timeval;
Result : int;
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2014, 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- --
-- Turn off polling, we do not want ATC polling to take place during
-- tasking operations. It causes infinite loops and other problems.
-package body System.OS_Interface is
+with Interfaces.C.Extensions;
+package body System.OS_Interface is
use Interfaces.C;
+ use Interfaces.C.Extensions;
-----------------
-- To_Duration --
use Interfaces;
- type timeval is array (1 .. 2) of C.long;
+ type timeval is array (1 .. 3) of C.long;
+ -- The timeval array is sized to contain long_long sec and long usec.
+ -- If long_long'Size = long'Size then it will be overly large but that
+ -- won't effect the implementation since it's not accessed directly.
procedure timeval_to_duration
(T : not null access timeval;
- sec : not null access C.long;
+ sec : not null access C.Extensions.long_long;
usec : not null access C.long);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6;
- sec : aliased C.long;
+ sec : aliased C.Extensions.long_long;
usec : aliased C.long;
TV : aliased timeval;
Result : int;
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2014, 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- --
-----------
function Clock return Duration is
- type timeval is array (1 .. 2) of Long_Integer;
+
+ type timeval is array (1 .. 3) of Long_Integer;
+ -- The timeval array is sized to contain Long_Long_Integer sec and
+ -- Long_Integer usec. If Long_Long_Integer'Size = Long_Integer'Size then
+ -- it will be overly large but that will not effect the implementation
+ -- since it is not accessed directly.
procedure timeval_to_duration
(T : not null access timeval;
- sec : not null access Long_Integer;
+ sec : not null access Long_Long_Integer;
usec : not null access Long_Integer);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6;
- sec : aliased Long_Integer;
+ sec : aliased Long_Long_Integer;
usec : aliased Long_Integer;
TV : aliased timeval;
Result : Integer;
-- operations. It causes infinite loops and other problems.
with Interfaces.C;
+with Interfaces.C.Extensions;
with System.Task_Info;
with System.Tasking.Debug;
use System.Tasking.Debug;
use System.Tasking;
use Interfaces.C;
+ use Interfaces.C.Extensions;
use System.OS_Interface;
use System.Parameters;
use System.OS_Primitives;
procedure timeval_to_duration
(T : not null access timeval;
- sec : not null access C.long;
+ sec : not null access C.Extensions.long_long;
usec : not null access C.long);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6;
- sec : aliased C.long;
+ sec : aliased C.Extensions.long_long;
usec : aliased C.long;
TV : aliased timeval;
Result : int;
Analyze_Dimension (N);
Eval_Qualified_Expression (N);
+
+ -- If we still have a qualified expression after the static evaluation,
+ -- then apply a scalar range check if needed. The reason that we do this
+ -- after the Eval call is that otherwise, the application of the range
+ -- check may convert an illegal static expression and result in warning
+ -- rather than giving an error (e.g Integer'(Integer'Last + 1)).
+
+ if Nkind (N) = N_Qualified_Expression and then Is_Scalar_Type (Typ) then
+ Apply_Scalar_Range_Check (Expr, Typ);
+ end if;
end Resolve_Qualified_Expression;
------------------------------
projects / gcc.git / commitdiff