FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
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.

From-SVN: r213587
This commit is contained in:
Arnaud Charlet 2014-08-04 15:16:24 +02:00
parent bc3c2eca1a
commit 6cf7eae689
9 changed files with 79 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
gcc/ada/ChangeLog
View file

@ -1,3 +1,25 @@
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.

8
gcc/ada/cal.c
View file

@ -59,16 +59,16 @@
#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;

15
gcc/ada/g-calend.adb
View file

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -29,8 +29,9 @@
-- --
------------------------------------------------------------------------------
package body GNAT.Calendar is
with Interfaces.C.Extensions;
package body GNAT.Calendar is
use Ada.Calendar;
use Interfaces;
@ -341,12 +342,12 @@ package body GNAT.Calendar is
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
@ -361,14 +362,14 @@ package body GNAT.Calendar is
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
@ -376,7 +377,7 @@ package body GNAT.Calendar is
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;

4
gcc/ada/g-calend.ads
View file

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -162,7 +162,7 @@ private
-- 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;

15
gcc/ada/s-osinte-android.adb
View file

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -38,7 +38,9 @@ pragma Polling (Off);
-- 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
-----------------
@ -88,16 +90,19 @@ 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;

15
gcc/ada/s-osinte-darwin.adb
View file

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -35,9 +35,11 @@ pragma Polling (Off);
-- 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 --
@ -97,16 +99,19 @@ 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;

13
gcc/ada/s-osprim-posix.adb
View file

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -54,16 +54,21 @@ package body System.OS_Primitives is
-----------
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;

6
gcc/ada/s-taprop-linux.adb
View file

@ -39,6 +39,7 @@ pragma Polling (Off);
-- operations. It causes infinite loops and other problems.
with Interfaces.C;
with Interfaces.C.Extensions;
with System.Task_Info;
with System.Tasking.Debug;
@ -61,6 +62,7 @@ package body System.Task_Primitives.Operations is
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;
@ -629,12 +631,12 @@ package body System.Task_Primitives.Operations is
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;

10
gcc/ada/sem_res.adb
View file

@ -9058,6 +9058,16 @@ package body Sem_Res is
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;
------------------------------