OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2017-01-20  Thomas Quinot  <quinot@adacore.com>

	* sem_warn.adb (Warn_On_Useless_Assignment): Adjust wording of warning
	message.

2017-01-20  Nicolas Roche  <roche@adacore.com>

	* terminals.c: Ignore failures on setpgid and tcsetpgrp commands.

2017-01-20  Bob Duff  <duff@adacore.com>

	* sem_eval.adb (Compile_Time_Compare): Disable the expr+literal
	(etc) optimizations when the type is modular.

2017-01-20  Yannick Moy  <moy@adacore.com>

	* sem_ch6.adb (Move_Pragmas): move some pragmas,
	but copy the SPARK_Mode pragma instead of moving it.
	(Build_Subprogram_Declaration): Ensure that the generated spec
	and original body share the same SPARK_Pragma aspect/pragma.
	* sem_util.adb, sem_util.ads (Copy_SPARK_Mode_Aspect): New
	procedure to copy SPARK_Mode aspect.

2017-01-20  Bob Duff  <duff@adacore.com>

	* sem_ch3.adb (Analyze_Declarations): Disable Resolve_Aspects
	even in ASIS mode.
	* sem_ch13.adb (Resolve_Name): Enable setting the entity to
	Empty even in ASIS mode.

From-SVN: r244720
This commit is contained in:
Arnaud Charlet 2017-01-20 15:51:39 +01:00
parent a395b2e5cd
commit 0a3ec628c1
9 changed files with 118 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
gcc/ada/ChangeLog
View File

@ -1,3 +1,33 @@
2017-01-20 Thomas Quinot <quinot@adacore.com>
* sem_warn.adb (Warn_On_Useless_Assignment): Adjust wording of warning
message.
2017-01-20 Nicolas Roche <roche@adacore.com>
* terminals.c: Ignore failures on setpgid and tcsetpgrp commands.
2017-01-20 Bob Duff <duff@adacore.com>
* sem_eval.adb (Compile_Time_Compare): Disable the expr+literal
(etc) optimizations when the type is modular.
2017-01-20 Yannick Moy <moy@adacore.com>
* sem_ch6.adb (Move_Pragmas): move some pragmas,
but copy the SPARK_Mode pragma instead of moving it.
(Build_Subprogram_Declaration): Ensure that the generated spec
and original body share the same SPARK_Pragma aspect/pragma.
* sem_util.adb, sem_util.ads (Copy_SPARK_Mode_Aspect): New
procedure to copy SPARK_Mode aspect.
2017-01-20 Bob Duff <duff@adacore.com>
* sem_ch3.adb (Analyze_Declarations): Disable Resolve_Aspects
even in ASIS mode.
* sem_ch13.adb (Resolve_Name): Enable setting the entity to
Empty even in ASIS mode.
2017-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch9.adb: minor style fixes in comments.

2
gcc/ada/sem_ch13.adb
View File

@ -12731,7 +12731,7 @@ package body Sem_Ch13 is
elsif Nkind (N) = N_Identifier and then Chars (N) /= Chars (E) then
Find_Direct_Name (N);
if not ASIS_Mode then
if True or else not ASIS_Mode then -- ????
Set_Entity (N, Empty);
end if;

2
gcc/ada/sem_ch3.adb
View File

@ -2570,7 +2570,7 @@ package body Sem_Ch3 is
-- rejected. Pending notification we restrict this call to
-- ASIS mode.
if ASIS_Mode then
if False and then ASIS_Mode then -- ????
Resolve_Aspects;
end if;

37
gcc/ada/sem_ch6.adb
View File

@ -2399,8 +2399,10 @@ package body Sem_Ch6 is
-- of subprogram body From and insert them after node To. The pragmas
-- in question are:
-- Ghost
-- SPARK_Mode
-- Volatile_Function
-- Also copy pragma SPARK_Mode if present in the declarative list
-- of subprogram body From and insert it after node To. This pragma
-- should not be moved, as it applies to the body too.
------------------
-- Move_Pragmas --
@ -2425,14 +2427,17 @@ package body Sem_Ch6 is
while Present (Decl) loop
Next_Decl := Next (Decl);
if Nkind (Decl) = N_Pragma
and then Nam_In (Pragma_Name_Unmapped (Decl),
Name_Ghost,
Name_SPARK_Mode,
Name_Volatile_Function)
then
Remove (Decl);
Insert_After (To, Decl);
if Nkind (Decl) = N_Pragma then
if Pragma_Name_Unmapped (Decl) = Name_SPARK_Mode then
Insert_After (To, New_Copy_Tree (Decl));
elsif Nam_In (Pragma_Name_Unmapped (Decl),
Name_Ghost,
Name_Volatile_Function)
then
Remove (Decl);
Insert_After (To, Decl);
end if;
end if;
Decl := Next_Decl;
@ -2463,6 +2468,13 @@ package body Sem_Ch6 is
Move_Aspects (N, To => Subp_Decl);
Move_Pragmas (N, To => Subp_Decl);
-- Ensure that the generated corresponding spec and original body
-- share the same SPARK_Mode pragma or aspect. As a result, both have
-- the same SPARK_Mode attributes, and the global SPARK_Mode value is
-- correctly set for local subprograms.
Copy_SPARK_Mode_Aspect (Subp_Decl, To => N);
Analyze (Subp_Decl);
-- Propagate the attributes Rewritten_For_C and Corresponding_Proc to
@ -2515,13 +2527,6 @@ package body Sem_Ch6 is
Body_Spec := Copy_Subprogram_Spec (Body_Spec);
Set_Specification (N, Body_Spec);
Body_Id := Analyze_Subprogram_Specification (Body_Spec);
-- Ensure that the generated corresponding spec and original body
-- share the same SPARK_Mode attributes.
Set_SPARK_Pragma (Body_Id, SPARK_Pragma (Spec_Id));
Set_SPARK_Pragma_Inherited
(Body_Id, SPARK_Pragma_Inherited (Spec_Id));
end Build_Subprogram_Declaration;
----------------------------

47
gcc/ada/sem_eval.adb
View File

@ -1142,7 +1142,7 @@ package body Sem_Eval is
return Unknown;
end if;
-- We do not attempt comparisons for packed arrays arrays represented as
-- We do not attempt comparisons for packed arrays represented as
-- modular types, where the semantics of comparison is quite different.
if Is_Packed_Array_Impl_Type (Ltyp)
@ -1329,28 +1329,35 @@ package body Sem_Eval is
-- J .. J + 1. This code can conclude LT with a difference of 1,
-- even if the range of J is not known.
declare
Lnode : Node_Id;
Loffs : Uint;
Rnode : Node_Id;
Roffs : Uint;
-- This would be wrong for modular types (e.g. X < X + 1 is False if
-- X is the largest number).
begin
Compare_Decompose (L, Lnode, Loffs);
Compare_Decompose (R, Rnode, Roffs);
if not Is_Modular_Integer_Type (Ltyp)
and then not Is_Modular_Integer_Type (Rtyp)
then
declare
Lnode : Node_Id;
Loffs : Uint;
Rnode : Node_Id;
Roffs : Uint;
if Is_Same_Value (Lnode, Rnode) then
if Loffs = Roffs then
return EQ;
elsif Loffs < Roffs then
Diff.all := Roffs - Loffs;
return LT;
else
Diff.all := Loffs - Roffs;
return GT;
begin
Compare_Decompose (L, Lnode, Loffs);
Compare_Decompose (R, Rnode, Roffs);
if Is_Same_Value (Lnode, Rnode) then
if Loffs = Roffs then
return EQ;
elsif Loffs < Roffs then
Diff.all := Roffs - Loffs;
return LT;
else
Diff.all := Loffs - Roffs;
return GT;
end if;
end if;
end if;
end;
end;
end if;
-- Next, try range analysis and see if operand ranges are disjoint

18
gcc/ada/sem_util.adb
View File

@ -4999,6 +4999,24 @@ package body Sem_Util is
return Plist;
end Copy_Parameter_List;
----------------------------
-- Copy_SPARK_Mode_Aspect --
----------------------------
procedure Copy_SPARK_Mode_Aspect (From : Node_Id; To : Node_Id) is
pragma Assert (not Has_Aspects (To));
Asp : Node_Id;
begin
if Has_Aspects (From) then
Asp := Find_Aspect (Defining_Entity (From), Aspect_SPARK_Mode);
if Present (Asp) then
Set_Aspect_Specifications (To, New_List (New_Copy_Tree (Asp)));
Set_Has_Aspects (To, True);
end if;
end if;
end Copy_SPARK_Mode_Aspect;
--------------------------
-- Copy_Subprogram_Spec --
--------------------------

6
gcc/ada/sem_util.ads
View File

@ -424,6 +424,12 @@ package Sem_Util is
-- of inlining, and for private protected ops. Also used to create bodies
-- for stubbed subprograms.
procedure Copy_SPARK_Mode_Aspect (From : Node_Id; To : Node_Id);
-- Copy the SPARK_Mode aspect if present in the aspect specifications
-- of node From to node To. On entry it is assumed that To does not have
-- aspect specifications. If From has no aspects, the routine has no
-- effect.
function Copy_Subprogram_Spec (Spec : Node_Id) return Node_Id;
-- Replicate a function or a procedure specification denoted by Spec. The
-- resulting tree is an exact duplicate of the original tree. New entities

15
gcc/ada/sem_warn.adb
View File

@ -4323,7 +4323,12 @@ package body Sem_Warn is
begin
-- Don't give this for OUT and IN OUT formals, since
-- clearly caller may reference the assigned value. Also
-- never give such warnings for internal variables.
-- never give such warnings for internal variables. In
-- either case, word the warning in a conditional way,
-- because in the case of a component of a controlled
-- type, the assigned value might be referenced in the
-- Finalize operation, so we can't make a definitive
-- statement that it's never referenced.
if Ekind (Ent) = E_Variable
and then not Is_Internal_Name (Chars (Ent))
@ -4335,13 +4340,13 @@ package body Sem_Warn is
N_Parameter_Association)
then
Error_Msg_NE
("?m?& modified by call, but value never "
& "referenced", LA, Ent);
("?m?& modified by call, but value might not "
& "be referenced", LA, Ent);
else
Error_Msg_NE -- CODEFIX
("?m?useless assignment to&, value never "
& "referenced!", LA, Ent);
("?m?possibly useless assignment to&, value "
& "might not be referenced!", LA, Ent);
end if;
end if;
end;

8
gcc/ada/terminals.c
View File

@ -1425,10 +1425,10 @@ __gnat_setup_child_communication
if (desc->slave_fd > 2) close (desc->slave_fd);
/* adjust process group settings */
if ((status = setpgid (pid, pid)) == -1)
return -1;
if ((status = tcsetpgrp (0, pid)) == -1)
return -1;
/* ignore failures of the following two commands as the context might not
* allow making those changes. */
setpgid (pid, pid);
tcsetpgrp (0, pid);
/* launch the program */
execvp (new_argv[0], new_argv);