Skip to content

R
riscv-gcc-1
Commit d59179b1 by Arnaud Charlet
Options

[multiple changes] 

2017-05-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Fully_Conformant_Expressions): Two entity
	references are fully conformant if they are both expansions
	of the discriminant of a protected type, within one of the
	protected operations. One occurrence may be expanded into a
	constant declaration while the other is an input parameter to
	the corresponding generated subprogram.

2017-05-02  Justin Squirek  <squirek@adacore.com>

	* sem_ch3.adb (Check_For_Null_Excluding_Components): Created for
	recursivly searching composite-types for null-excluding access
	types and verifying them.
	(Analyze_Object_Declaration): Add a
	call to Check_Null_Excluding_Components for static verification
	of non-initialized objects.
	* checks.adb, checks.ads (Null_Exclusion_Static_Checks): Added
	a parameter for a composite-type's component and an extra case
	for printing component information.

2017-05-02  Yannick Moy  <moy@adacore.com>

	* sem_ch10.adb (Analyze_Subunit): Take
	configuration pragma into account when restoring appropriate
	pragma for analysis of subunit.

2017-05-02  Justin Squirek  <squirek@adacore.com>

	* s-tasren.adb, s-tasini.adb, s-taprop-linux.adb,
	s-mudido-affinity.adb,, a-exetim-posix.adb, a-direio.adb,
	g-socket.adb, s-taenca.adb, s-fileio.adb: Remove unused use-type
	clauses from the runtime.

From-SVN: r247465
parent 26de50b0
Showing with 223 additions and 55 deletions
gcc/ada/ChangeLog
2017-05-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Fully_Conformant_Expressions): Two entity
references are fully conformant if they are both expansions
of the discriminant of a protected type, within one of the
protected operations. One occurrence may be expanded into a
constant declaration while the other is an input parameter to
the corresponding generated subprogram.
2017-05-02 Justin Squirek <squirek@adacore.com>
* sem_ch3.adb (Check_For_Null_Excluding_Components): Created for
recursivly searching composite-types for null-excluding access
types and verifying them.
(Analyze_Object_Declaration): Add a
call to Check_Null_Excluding_Components for static verification
of non-initialized objects.
* checks.adb, checks.ads (Null_Exclusion_Static_Checks): Added
a parameter for a composite-type's component and an extra case
for printing component information.
2017-05-02 Yannick Moy <moy@adacore.com>
* sem_ch10.adb (Analyze_Subunit): Take
configuration pragma into account when restoring appropriate
pragma for analysis of subunit.
2017-05-02 Justin Squirek <squirek@adacore.com>
* s-tasren.adb, s-tasini.adb, s-taprop-linux.adb,
s-mudido-affinity.adb,, a-exetim-posix.adb, a-direio.adb,
g-socket.adb, s-taenca.adb, s-fileio.adb: Remove unused use-type
clauses from the runtime.
2017-05-02 Eric Botcazou <ebotcazou@adacore.com>
* freeze.adb (Check_Component_Storage_Order): Do not treat bit-packed
......
gcc/ada/a-direio.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, 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- --
......@@ -39,12 +39,9 @@ with System; use System;
with System.CRTL;
with System.File_Control_Block;
with System.File_IO;
with System.Direct_IO;
with System.Storage_Elements;
with Ada.Unchecked_Conversion;
use type System.Direct_IO.Count;
package body Ada.Direct_IO is
Zeroes : constant System.Storage_Elements.Storage_Array :=
......
gcc/ada/a-exetim-posix.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-2015, Free Software Foundation, Inc. --
-- Copyright (C) 2007-2017, 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- --
......@@ -164,7 +164,7 @@ package body Ada.Execution_Time is
SC : out Ada.Real_Time.Seconds_Count;
TS : out Ada.Real_Time.Time_Span)
is
use type Ada.Real_Time.Time;
begin
Ada.Real_Time.Split (Ada.Real_Time.Time (T), SC, TS);
end Split;
......
gcc/ada/checks.adb
......@@ -4037,7 +4037,10 @@ package body Checks is
-- Null_Exclusion_Static_Checks --
----------------------------------
procedure Null_Exclusion_Static_Checks (N : Node_Id) is
procedure Null_Exclusion_Static_Checks
(N : Node_Id;
Comp : Node_Id := Empty)
is
Error_Node : Node_Id;
Expr : Node_Id;
Has_Null : constant Boolean := Has_Null_Exclusion (N);
......@@ -4119,11 +4122,27 @@ package body Checks is
Set_Expression (N, Make_Null (Sloc (N)));
Set_Etype (Expression (N), Etype (Defining_Identifier (N)));
Apply_Compile_Time_Constraint_Error
(N => Expression (N),
Msg =>
"(Ada 2005) null-excluding objects must be initialized??",
Reason => CE_Null_Not_Allowed);
if Present (Comp) then
-- Specialize the error message to indicate that we are dealing
-- with an uninitialized composite object that has a defaulted
-- null-excluding component.
Error_Msg_Name_1 := Chars (Defining_Identifier (Comp));
Error_Msg_Name_2 := Chars (Defining_Identifier (N));
Apply_Compile_Time_Constraint_Error
(N => Expression (N),
Msg => "(Ada 2005) null-excluding component % of object % " &
"must be initialized??",
Reason => CE_Null_Not_Allowed);
else
Apply_Compile_Time_Constraint_Error
(N => Expression (N),
Msg =>
"(Ada 2005) null-excluding objects must be initialized??",
Reason => CE_Null_Not_Allowed);
end if;
end if;
-- Check that a null-excluding component, formal or object is not being
......
gcc/ada/checks.ads
......@@ -915,8 +915,14 @@ package Checks is
-- Chars (Related_Id)_FIRST/_LAST. For suggested use of these parameters
-- see the warning in the body of Sem_Ch3.Process_Range_Expr_In_Decl.
procedure Null_Exclusion_Static_Checks (N : Node_Id);
procedure Null_Exclusion_Static_Checks
(N : Node_Id;
Comp : Node_Id := Empty);
-- Ada 2005 (AI-231): Check bad usages of the null-exclusion issue
--
-- When a value for Comp is supplied (as in the case of an uninitialized
-- null-excluding component within a composite object), a reported error
-- will indicate the offending component instead of the object itself.
procedure Remove_Checks (Expr : Node_Id);
-- Remove all checks from Expr except those that are only executed
......
gcc/ada/g-socket.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2016, AdaCore --
-- Copyright (C) 2001-2017, 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- --
......@@ -2633,8 +2633,6 @@ package body GNAT.Sockets is
----------------------
function To_Service_Entry (E : Servent_Access) return Service_Entry_Type is
use type C.size_t;
Aliases_Count : Natural;
begin
......
gcc/ada/s-fileio.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, 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- --
......@@ -33,7 +33,6 @@ with Ada.Finalization; use Ada.Finalization;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Ada.Unchecked_Deallocation;
with Interfaces.C;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System.Case_Util; use System.Case_Util;
......@@ -48,7 +47,6 @@ package body System.File_IO is
package SSL renames System.Soft_Links;
use type CRTL.size_t;
use type Interfaces.C.int;
----------------------
-- Global Variables --
......
gcc/ada/s-mudido-affinity.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2011-2015, Free Software Foundation, Inc. --
-- Copyright (C) 2011-2017, 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- --
......@@ -77,8 +77,6 @@ package body System.Multiprocessors.Dispatching_Domains is
is
Target : constant ST.Task_Id := Convert_Ids (T);
use type ST.Dispatching_Domain_Access;
begin
-- The exception Dispatching_Domain_Error is propagated if T is already
-- assigned to a Dispatching_Domain other than
......@@ -127,7 +125,6 @@ package body System.Multiprocessors.Dispatching_Domains is
use type ST.Dispatching_Domain;
use type ST.Dispatching_Domain_Access;
use type ST.Array_Allocated_Tasks;
use type ST.Task_Id;
T : ST.Task_Id;
......@@ -331,8 +328,6 @@ package body System.Multiprocessors.Dispatching_Domains is
is
Target : constant ST.Task_Id := Convert_Ids (T);
use type ST.Dispatching_Domain_Access;
begin
-- The exception Dispatching_Domain_Error is propagated if CPU is not
-- one of the processors of the Dispatching_Domain on which T is
......
gcc/ada/s-taenca.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, 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- --
......@@ -533,8 +533,6 @@ package body System.Tasking.Entry_Calls is
Self_Id : constant Task_Id := Entry_Call.Self;
Timedout : Boolean := False;
use type Ada.Exceptions.Exception_Id;
begin
-- This procedure waits for the entry call to be served, with a timeout.
-- It tries to cancel the call if the timeout expires before the call is
......
gcc/ada/s-taprop-linux.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, 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- --
......@@ -1525,8 +1525,6 @@ package body System.Task_Primitives.Operations is
-- 's' Interrupt_State pragma set state to System (use "default"
-- system handler)
use type System.Multiprocessors.CPU_Range;
begin
Environment_Task_Id := Environment_Task;
......
gcc/ada/s-tasini.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, 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- --
......@@ -38,8 +38,6 @@ pragma Polling (Off);
-- routines in this package, and more to the point, if we try to poll it can
-- cause infinite loops.
with Ada.Exceptions;
with System.Task_Primitives;
with System.Task_Primitives.Operations;
with System.Soft_Links;
......@@ -234,7 +232,6 @@ package body System.Tasking.Initialization is
-- Call only when holding no locks
procedure Do_Pending_Action (Self_ID : Task_Id) is
use type Ada.Exceptions.Exception_Id;
begin
pragma Assert (Self_ID = Self and then Self_ID.Deferral_Level = 0);
......
gcc/ada/s-tasren.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2017, 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- --
......@@ -547,8 +547,6 @@ package body System.Tasking.Rendezvous is
Source : Ada.Exceptions.Exception_Occurrence);
pragma Import (C, Transfer_Occurrence, "__gnat_transfer_occurrence");
use type STPE.Protection_Entries_Access;
begin
-- The deferral level is critical here, since we want to raise an
-- exception or allow abort to take place, if there is an exception or
......
gcc/ada/sem_ch10.adb
......@@ -2288,10 +2288,10 @@ package body Sem_Ch10 is
Pop_Scope;
end Remove_Scope;
Saved_SM : constant SPARK_Mode_Type := SPARK_Mode;
Saved_SMP : constant Node_Id := SPARK_Mode_Pragma;
Saved_SM : SPARK_Mode_Type := SPARK_Mode;
Saved_SMP : Node_Id := SPARK_Mode_Pragma;
-- Save the SPARK mode-related data to restore on exit. Removing
-- eclosing scopes and contexts to provide a clean environment for the
-- enclosing scopes and contexts to provide a clean environment for the
-- context of the subunit will eliminate any previously set SPARK_Mode.
-- Start of processing for Analyze_Subunit
......@@ -2351,6 +2351,15 @@ package body Sem_Ch10 is
Analyze_Subunit_Context;
-- Take into account the effect of any SPARK_Mode configuration
-- pragma, which takes precedence over a different value of
-- SPARK_Mode inherited from the context of the stub.
if SPARK_Mode /= None then
Saved_SM := SPARK_Mode;
Saved_SMP := SPARK_Mode_Pragma;
end if;
Re_Install_Parents (Lib_Unit, Par_Unit);
Set_Is_Immediately_Visible (Par_Unit);
......@@ -2392,7 +2401,8 @@ package body Sem_Ch10 is
Generate_Parent_References (Unit (N), Par_Unit);
-- Reinstall the SPARK_Mode which was in effect prior to any scope and
-- context manipulations.
-- context manipulations, taking into account a possible SPARK_Mode
-- configuration pragma if present.
Install_SPARK_Mode (Saved_SM, Saved_SMP);
......
gcc/ada/sem_ch3.adb
......@@ -3588,6 +3588,13 @@ package body Sem_Ch3 is
Prev_Entity : Entity_Id := Empty;
procedure Check_For_Null_Excluding_Components
(Obj_Typ : Entity_Id;
Obj_Decl : Node_Id);
-- Recursively verify that each null-excluding component of an object
-- declaration's type has explicit initialization, and generate
-- compile-time warnings for each one that does not.
function Count_Tasks (T : Entity_Id) return Uint;
-- This function is called when a non-generic library level object of a
-- task type is declared. Its function is to count the static number of
......@@ -3607,6 +3614,100 @@ package body Sem_Ch3 is
-- Any other relevant delayed aspects on object declarations ???
-----------------------------------------
-- Check_For_Null_Excluding_Components --
-----------------------------------------
procedure Check_For_Null_Excluding_Components
(Obj_Typ : Entity_Id;
Obj_Decl : Node_Id)
is
procedure Check_Component
(Comp_Typ : Entity_Id;
Comp_Decl : Node_Id := Empty);
-- Perform compile-time null-exclusion checks on a given component
-- and all of its subcomponents, if any.
---------------------
-- Check_Component --
---------------------
procedure Check_Component
(Comp_Typ : Entity_Id;
Comp_Decl : Node_Id := Empty)
is
Comp : Entity_Id;
T : Entity_Id;
begin
-- Return without further checking if the component has explicit
-- initialization or does not come from source.
if Present (Comp_Decl) then
if not Comes_From_Source (Comp_Decl)
or else Present (Expression (Comp_Decl))
then
return;
end if;
end if;
if Is_Incomplete_Or_Private_Type (Comp_Typ)
and then Present (Full_View (Comp_Typ))
then
T := Full_View (Comp_Typ);
else
T := Comp_Typ;
end if;
-- Verify a component of a null-excluding access type
if Is_Access_Type (T)
and then Can_Never_Be_Null (T)
then
Null_Exclusion_Static_Checks (Obj_Decl, Comp_Decl);
-- Check array type components
elsif Is_Array_Type (T) then
-- There is no suitable component when the object is of an
-- array type. However, a namable component may appear at some
-- point during the recursive inspection, but not at the top
-- level.
if Comp_Decl = Obj_Decl then
Check_Component (Component_Type (T));
else
Check_Component (Component_Type (T), Comp_Decl);
end if;
-- If T allows named components, then iterate through them,
-- recursively verifying all subcomponents.
-- NOTE: Due to the complexities involved with checking components
-- of nontrivial types with discriminants (variant records and
-- the like), no static checking is performed on them. ???
elsif (Is_Concurrent_Type (T)
or else Is_Incomplete_Or_Private_Type (T)
or else Is_Record_Type (T))
and then not Has_Discriminants (T)
then
Comp := First_Component (T);
while Present (Comp) loop
Check_Component (Etype (Comp), Parent (Comp));
Comp := Next_Component (Comp);
end loop;
end if;
end Check_Component;
-- Start processing for Check_For_Null_Excluding_Components
begin
Check_Component (Obj_Typ, Obj_Decl);
end Check_For_Null_Excluding_Components;
-----------------
-- Count_Tasks --
-----------------
......@@ -3808,25 +3909,34 @@ package body Sem_Ch3 is
-- Ada 2005 (AI-231): Propagate the null-excluding attribute and carry
-- out some static checks.
if Ada_Version >= Ada_2005 and then Can_Never_Be_Null (T) then
if Ada_Version >= Ada_2005 then
-- In case of aggregates we must also take care of the correct
-- initialization of nested aggregates bug this is done at the
-- point of the analysis of the aggregate (see sem_aggr.adb) ???
if Present (Expression (N))
and then Nkind (Expression (N)) = N_Aggregate
then
null;
if Can_Never_Be_Null (T) then
if Present (Expression (N))
and then Nkind (Expression (N)) = N_Aggregate
then
null;
else
declare
Save_Typ : constant Entity_Id := Etype (Id);
begin
Set_Etype (Id, T); -- Temp. decoration for static checks
Null_Exclusion_Static_Checks (N);
Set_Etype (Id, Save_Typ);
end;
end if;
-- We might be dealing with an object of a composite type containing
-- null-excluding components without an aggregate, so we must verify
-- that such components have default initialization.
else
declare
Save_Typ : constant Entity_Id := Etype (Id);
begin
Set_Etype (Id, T); -- Temp. decoration for static checks
Null_Exclusion_Static_Checks (N);
Set_Etype (Id, Save_Typ);
end;
Check_For_Null_Excluding_Components (T, N);
end if;
end if;
......
gcc/ada/sem_ch6.adb
......@@ -8770,6 +8770,16 @@ package body Sem_Ch6 is
and then Ekind (Entity (E1)) = E_Discriminant
and then Ekind (Entity (E2)) = E_In_Parameter)
-- The discriminant of a protected type is transformed into
-- a local constant and then into a parameter of a protected
-- operation.
or else (Ekind (Entity (E1)) = E_Constant
and then Ekind (Entity (E2)) = E_In_Parameter
and then Present (Discriminal_Link (Entity (E1)))
and then Discriminal_Link (Entity (E1)) =
Discriminal_Link (Entity (E2)))
-- AI12-050: The loop variables of quantified expressions
-- match if they have the same identifier, even though they
-- are different entities.
......
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