sem_res.adb (Within_Subprogram_Call): Detect also nodes that appear in entry calls.

2016-04-19  Arnaud Charlet  <charlet@adacore.com>

	* sem_res.adb (Within_Subprogram_Call): Detect
	also nodes that appear in entry calls.
	(Resolve_Actuals, Insert_Default): Propagate
	dimension information if any, from default expression to the
	copy that appears in the list of actuals.
	* uintp.ads: minor whitespace fix in comment.
	* sem_prag.adb, stringt.adb, inline.adb, lib-xref-spark_specific.adb:
	Minor code cleanup.
	* set_targ.adb (Set_Targ): convert directly from
	Natural to Pos, without intermediate conversion to Int.

From-SVN: r235197
This commit is contained in:
Arnaud Charlet 2016-04-19 13:06:01 +00:00 committed by Arnaud Charlet
parent db7e372172
commit e90e9503df
8 changed files with 36 additions and 18 deletions

View File

@ -1,3 +1,16 @@
2016-04-19 Arnaud Charlet <charlet@adacore.com>
* sem_res.adb (Within_Subprogram_Call): Detect
also nodes that appear in entry calls.
(Resolve_Actuals, Insert_Default): Propagate
dimension information if any, from default expression to the
copy that appears in the list of actuals.
* uintp.ads: minor whitespace fix in comment.
* sem_prag.adb, stringt.adb, inline.adb, lib-xref-spark_specific.adb:
Minor code cleanup.
* set_targ.adb (Set_Targ): convert directly from
Natural to Pos, without intermediate conversion to Int.
2016-04-19 Arnaud Charlet <charlet@adacore.com> 2016-04-19 Arnaud Charlet <charlet@adacore.com>
* sem_ch6.adb (Process_Formals): Mark suspicious reference to * sem_ch6.adb (Process_Formals): Mark suspicious reference to

View File

@ -2242,7 +2242,7 @@ package body Inline is
Lab_Decl : Node_Id; Lab_Decl : Node_Id;
Lab_Id : Node_Id; Lab_Id : Node_Id;
New_A : Node_Id; New_A : Node_Id;
Num_Ret : Int := 0; Num_Ret : Nat := 0;
Ret_Type : Entity_Id; Ret_Type : Entity_Id;
Targ : Node_Id; Targ : Node_Id;

View File

@ -870,8 +870,8 @@ package body SPARK_Specific is
Line := 0; Line := 0;
Col := 0; Col := 0;
else else
Line := Int (Get_Logical_Line_Number (Ref_Entry.Def)); Line := Nat (Get_Logical_Line_Number (Ref_Entry.Def));
Col := Int (Get_Column_Number (Ref_Entry.Def)); Col := Nat (Get_Column_Number (Ref_Entry.Def));
end if; end if;
-- References to constant objects without variable inputs (see -- References to constant objects without variable inputs (see
@ -895,9 +895,9 @@ package body SPARK_Specific is
Entity_Col => Col, Entity_Col => Col,
File_Num => Dependency_Num (Ref.Lun), File_Num => Dependency_Num (Ref.Lun),
Scope_Num => Get_Scope_Num (Ref.Ref_Scope), Scope_Num => Get_Scope_Num (Ref.Ref_Scope),
Line => Int (Get_Logical_Line_Number (Ref.Loc)), Line => Nat (Get_Logical_Line_Number (Ref.Loc)),
Rtype => Typ, Rtype => Typ,
Col => Int (Get_Column_Number (Ref.Loc)))); Col => Nat (Get_Column_Number (Ref.Loc))));
end; end;
end loop; end loop;

View File

@ -6698,7 +6698,7 @@ package body Sem_Prag is
declare declare
Str : constant String_Id := Str : constant String_Id :=
Strval (Get_Pragma_Arg (Arg2)); Strval (Get_Pragma_Arg (Arg2));
Len : constant Int := String_Length (Str); Len : constant Nat := String_Length (Str);
Cont : Boolean; Cont : Boolean;
Ptr : Nat; Ptr : Nat;
CC : Char_Code; CC : Char_Code;
@ -21237,7 +21237,7 @@ package body Sem_Prag is
Check_Arg_Count (1); Check_Arg_Count (1);
if Nkind (A) = N_String_Literal then if Nkind (A) = N_String_Literal then
S := Strval (A); S := Strval (A);
declare declare
Slen : constant Natural := Natural (String_Length (S)); Slen : constant Natural := Natural (String_Length (S));
@ -28802,10 +28802,10 @@ package body Sem_Prag is
procedure Set_Encoded_Interface_Name (E : Entity_Id; S : Node_Id) is procedure Set_Encoded_Interface_Name (E : Entity_Id; S : Node_Id) is
Str : constant String_Id := Strval (S); Str : constant String_Id := Strval (S);
Len : constant Int := String_Length (Str); Len : constant Nat := String_Length (Str);
CC : Char_Code; CC : Char_Code;
C : Character; C : Character;
J : Int; J : Pos;
Hex : constant array (0 .. 15) of Character := "0123456789abcdef"; Hex : constant array (0 .. 15) of Character := "0123456789abcdef";

View File

@ -3379,6 +3379,10 @@ package body Sem_Res is
New_Scope => Current_Scope, New_Scope => Current_Scope,
New_Sloc => Loc); New_Sloc => Loc);
-- Propagate dimension information, if any.
Copy_Dimensions (Default_Value (F), Actval);
if Is_Concurrent_Type (Scope (Nam)) if Is_Concurrent_Type (Scope (Nam))
and then Has_Discriminants (Scope (Nam)) and then Has_Discriminants (Scope (Nam))
then then
@ -6882,7 +6886,7 @@ package body Sem_Res is
-- Determine whether an arbitrary node appears in a check node -- Determine whether an arbitrary node appears in a check node
function Within_Subprogram_Call (Nod : Node_Id) return Boolean; function Within_Subprogram_Call (Nod : Node_Id) return Boolean;
-- Determine whether an arbitrary node appears in a procedure call -- Determine whether an arbitrary node appears in a subprogram call
function Within_Volatile_Function (Id : Entity_Id) return Boolean; function Within_Volatile_Function (Id : Entity_Id) return Boolean;
-- Determine whether an arbitrary entity appears in a volatile -- Determine whether an arbitrary entity appears in a volatile
@ -6960,7 +6964,8 @@ package body Sem_Res is
Par := Nod; Par := Nod;
while Present (Par) loop while Present (Par) loop
if Nkind_In (Par, N_Function_Call, if Nkind_In (Par, N_Function_Call,
N_Procedure_Call_Statement) N_Procedure_Call_Statement,
N_Entry_Call_Statement)
then then
return True; return True;

View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2013-2014, Free Software Foundation, Inc. -- -- Copyright (C) 2013-2015, 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- --
@ -946,21 +946,21 @@ begin
T : FPT_Mode_Entry renames T : FPT_Mode_Entry renames
FPT_Mode_Table (FPT_Mode_Index_For (S_Float)); FPT_Mode_Table (FPT_Mode_Index_For (S_Float));
begin begin
Float_Size := Int (T.SIZE); Float_Size := Pos (T.SIZE);
end; end;
declare declare
T : FPT_Mode_Entry renames T : FPT_Mode_Entry renames
FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Float)); FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Float));
begin begin
Double_Size := Int (T.SIZE); Double_Size := Pos (T.SIZE);
end; end;
declare declare
T : FPT_Mode_Entry renames T : FPT_Mode_Entry renames
FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Long_Float)); FPT_Mode_Table (FPT_Mode_Index_For (S_Long_Long_Float));
begin begin
Long_Double_Size := Int (T.SIZE); Long_Double_Size := Pos (T.SIZE);
end; end;
end if; end if;

View File

@ -241,7 +241,7 @@ package body Stringt is
-- String_Chars table all at once. -- String_Chars table all at once.
S_First : constant Int := Strings.Table (S).String_Index; S_First : constant Int := Strings.Table (S).String_Index;
S_Len : constant Int := String_Length (S); S_Len : constant Nat := String_Length (S);
Old_Last : constant Int := String_Chars.Last; Old_Last : constant Int := String_Chars.Last;
New_Last : constant Int := Old_Last + S_Len; New_Last : constant Int := Old_Last + S_Len;

View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2015, 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- --
@ -431,7 +431,7 @@ private
-- Base is defined to allow efficient execution of the primitive operations -- Base is defined to allow efficient execution of the primitive operations
-- (a0, b0, c0) defined in the section "The Classical Algorithms" -- (a0, b0, c0) defined in the section "The Classical Algorithms"
-- (sec. 4.3.1) of Donald Knuth's "The Art of Computer Programming", -- (sec. 4.3.1) of Donald Knuth's "The Art of Computer Programming",
-- Vol. 2. These algorithms are used in this package. In particular, -- Vol. 2. These algorithms are used in this package. In particular,
-- the product of two single digits in this base fits in a 32-bit integer. -- the product of two single digits in this base fits in a 32-bit integer.