Skip to content

R
riscv-gcc-1
Commit 6cf7eae6 by Arnaud Charlet
Options

[multiple changes] 

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
parent bc3c2eca
Showing with 78 additions and 28 deletions
gcc/ada/ChangeLog
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> 2014-08-04 Robert Dewar <dewar@adacore.com>
* einfo.ads, einfo.adb (Is_Standard_String_Type): New function. * einfo.ads, einfo.adb (Is_Standard_String_Type): New function.
......
gcc/ada/cal.c
...@@ -59,16 +59,16 @@ ...@@ -59,16 +59,16 @@
#endif #endif
void 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; *usec = (long) t->tv_usec;
} }
void 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. */ fields types. */
t->tv_sec = sec; t->tv_sec = sec;
......
gcc/ada/g-calend.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -29,8 +29,9 @@ ...@@ -29,8 +29,9 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
package body GNAT.Calendar is with Interfaces.C.Extensions;
package body GNAT.Calendar is
use Ada.Calendar; use Ada.Calendar;
use Interfaces; use Interfaces;
...@@ -341,12 +342,12 @@ package body GNAT.Calendar is ...@@ -341,12 +342,12 @@ package body GNAT.Calendar is
procedure timeval_to_duration procedure timeval_to_duration
(T : not null access timeval; (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); usec : not null access C.long);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6; Micro : constant := 10**6;
sec : aliased C.long; sec : aliased C.Extensions.long_long;
usec : aliased C.long; usec : aliased C.long;
begin begin
...@@ -361,14 +362,14 @@ package body GNAT.Calendar is ...@@ -361,14 +362,14 @@ package body GNAT.Calendar is
function To_Timeval (D : Duration) return timeval is function To_Timeval (D : Duration) return timeval is
procedure duration_to_timeval procedure duration_to_timeval
(Sec : C.long; (Sec : C.Extensions.long_long;
Usec : C.long; Usec : C.long;
T : not null access timeval); T : not null access timeval);
pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval"); pragma Import (C, duration_to_timeval, "__gnat_duration_to_timeval");
Micro : constant := 10**6; Micro : constant := 10**6;
Result : aliased timeval; Result : aliased timeval;
sec : C.long; sec : C.Extensions.long_long;
usec : C.long; usec : C.long;
begin begin
...@@ -376,7 +377,7 @@ package body GNAT.Calendar is ...@@ -376,7 +377,7 @@ package body GNAT.Calendar is
sec := 0; sec := 0;
usec := 0; usec := 0;
else else
sec := C.long (D - 0.5); sec := C.Extensions.long_long (D - 0.5);
usec := C.long ((D - Duration (sec)) * Micro - 0.5); usec := C.long ((D - Duration (sec)) * Micro - 0.5);
end if; end if;
......
gcc/ada/g-calend.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -162,7 +162,7 @@ private ...@@ -162,7 +162,7 @@ private
-- This is a dummy declaration that should be the largest possible timeval -- This is a dummy declaration that should be the largest possible timeval
-- structure of all supported targets. -- 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 function Julian_Day
(Year : Ada.Calendar.Year_Number; (Year : Ada.Calendar.Year_Number;
......
gcc/ada/s-osinte-android.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -39,6 +39,8 @@ pragma Polling (Off); ...@@ -39,6 +39,8 @@ pragma Polling (Off);
-- that are needed by children of System. -- 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 package body System.OS_Interface is
----------------- -----------------
...@@ -88,16 +90,19 @@ package body System.OS_Interface is ...@@ -88,16 +90,19 @@ package body System.OS_Interface is
use Interfaces; 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 procedure timeval_to_duration
(T : not null access timeval; (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); usec : not null access C.long);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6; Micro : constant := 10**6;
sec : aliased C.long; sec : aliased C.Extensions.long_long;
usec : aliased C.long; usec : aliased C.long;
TV : aliased timeval; TV : aliased timeval;
Result : int; Result : int;
......
gcc/ada/s-osinte-darwin.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -35,9 +35,11 @@ pragma Polling (Off); ...@@ -35,9 +35,11 @@ pragma Polling (Off);
-- Turn off polling, we do not want ATC polling to take place during -- Turn off polling, we do not want ATC polling to take place during
-- tasking operations. It causes infinite loops and other problems. -- 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;
use Interfaces.C.Extensions;
----------------- -----------------
-- To_Duration -- -- To_Duration --
...@@ -97,16 +99,19 @@ package body System.OS_Interface is ...@@ -97,16 +99,19 @@ package body System.OS_Interface is
use Interfaces; 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 procedure timeval_to_duration
(T : not null access timeval; (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); usec : not null access C.long);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6; Micro : constant := 10**6;
sec : aliased C.long; sec : aliased C.Extensions.long_long;
usec : aliased C.long; usec : aliased C.long;
TV : aliased timeval; TV : aliased timeval;
Result : int; Result : int;
......
gcc/ada/s-osprim-posix.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -54,16 +54,21 @@ package body System.OS_Primitives is ...@@ -54,16 +54,21 @@ package body System.OS_Primitives is
----------- -----------
function Clock return Duration 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 procedure timeval_to_duration
(T : not null access timeval; (T : not null access timeval;
sec : not null access Long_Integer; sec : not null access Long_Long_Integer;
usec : not null access Long_Integer); usec : not null access Long_Integer);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6; Micro : constant := 10**6;
sec : aliased Long_Integer; sec : aliased Long_Long_Integer;
usec : aliased Long_Integer; usec : aliased Long_Integer;
TV : aliased timeval; TV : aliased timeval;
Result : Integer; Result : Integer;
......
gcc/ada/s-taprop-linux.adb
...@@ -39,6 +39,7 @@ pragma Polling (Off); ...@@ -39,6 +39,7 @@ pragma Polling (Off);
-- operations. It causes infinite loops and other problems. -- operations. It causes infinite loops and other problems.
with Interfaces.C; with Interfaces.C;
with Interfaces.C.Extensions;
with System.Task_Info; with System.Task_Info;
with System.Tasking.Debug; with System.Tasking.Debug;
...@@ -61,6 +62,7 @@ package body System.Task_Primitives.Operations is ...@@ -61,6 +62,7 @@ package body System.Task_Primitives.Operations is
use System.Tasking.Debug; use System.Tasking.Debug;
use System.Tasking; use System.Tasking;
use Interfaces.C; use Interfaces.C;
use Interfaces.C.Extensions;
use System.OS_Interface; use System.OS_Interface;
use System.Parameters; use System.Parameters;
use System.OS_Primitives; use System.OS_Primitives;
...@@ -629,12 +631,12 @@ package body System.Task_Primitives.Operations is ...@@ -629,12 +631,12 @@ package body System.Task_Primitives.Operations is
procedure timeval_to_duration procedure timeval_to_duration
(T : not null access timeval; (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); usec : not null access C.long);
pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration");
Micro : constant := 10**6; Micro : constant := 10**6;
sec : aliased C.long; sec : aliased C.Extensions.long_long;
usec : aliased C.long; usec : aliased C.long;
TV : aliased timeval; TV : aliased timeval;
Result : int; Result : int;
......
gcc/ada/sem_res.adb
...@@ -9058,6 +9058,16 @@ package body Sem_Res is ...@@ -9058,6 +9058,16 @@ package body Sem_Res is
Analyze_Dimension (N); Analyze_Dimension (N);
Eval_Qualified_Expression (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; end Resolve_Qualified_Expression;
------------------------------ ------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment