Commit b973629e by Arnaud Charlet

[multiple changes]

2014-07-29  Robert Dewar  <dewar@adacore.com>

	* exp_dbug.adb, g-expect.adb, sem_elab.adb: Minor typo fix.

2014-07-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Return_Type): Reject a return type that
	is a limited view when the context is a package body, because
	there is no subsequent place at which the non-limited view may
	become visible.
	(Process_Formals): Ditto.
	* sinfo.ads, par-ch3.adb: Minor reformatting.

From-SVN: r213178
parent a7737c19
2014-07-29 Robert Dewar <dewar@adacore.com>
* exp_dbug.adb, g-expect.adb, sem_elab.adb: Minor typo fix.
2014-07-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Return_Type): Reject a return type that
is a limited view when the context is a package body, because
there is no subsequent place at which the non-limited view may
become visible.
(Process_Formals): Ditto.
* sinfo.ads, par-ch3.adb: Minor reformatting.
2014-07-29 Jerome Lambourg <lambourg@adacore.com> 2014-07-29 Jerome Lambourg <lambourg@adacore.com>
* expect.c (__gnat_expect_poll): New parameter dead_process * expect.c (__gnat_expect_poll): New parameter dead_process
......
...@@ -332,11 +332,8 @@ package body Exp_Dbug is ...@@ -332,11 +332,8 @@ package body Exp_Dbug is
T : constant Entity_Id := Etype (N); T : constant Entity_Id := Etype (N);
begin begin
Enable := Enable :=
(Enable Enable or else (Ekind (T) in Array_Kind
or else and then Present (Packed_Array_Impl_Type (T)));
(Ekind (T) in Array_Kind
and then
Present (Packed_Array_Impl_Type (T))));
end Enable_If_Packed_Array; end Enable_If_Packed_Array;
---------------------- ----------------------
...@@ -397,8 +394,7 @@ package body Exp_Dbug is ...@@ -397,8 +394,7 @@ package body Exp_Dbug is
exit; exit;
when N_Selected_Component => when N_Selected_Component =>
Enable := Enable := Enable or else Is_Packed (Etype (Prefix (Ren)));
Enable or else Is_Packed (Etype (Prefix (Ren)));
Prepend_String_To_Buffer Prepend_String_To_Buffer
(Get_Name_String (Chars (Selector_Name (Ren)))); (Get_Name_String (Chars (Selector_Name (Ren))));
Prepend_String_To_Buffer ("XR"); Prepend_String_To_Buffer ("XR");
...@@ -406,10 +402,12 @@ package body Exp_Dbug is ...@@ -406,10 +402,12 @@ package body Exp_Dbug is
when N_Indexed_Component => when N_Indexed_Component =>
declare declare
X : Node_Id := Last (Expressions (Ren)); X : Node_Id;
begin begin
Enable_If_Packed_Array (Prefix (Ren)); Enable_If_Packed_Array (Prefix (Ren));
X := Last (Expressions (Ren));
while Present (X) loop while Present (X) loop
if not Output_Subscript (X, "XS") then if not Output_Subscript (X, "XS") then
Set_Materialize_Entity (Ent); Set_Materialize_Entity (Ent);
...@@ -423,7 +421,6 @@ package body Exp_Dbug is ...@@ -423,7 +421,6 @@ package body Exp_Dbug is
Ren := Prefix (Ren); Ren := Prefix (Ren);
when N_Slice => when N_Slice =>
Enable_If_Packed_Array (Prefix (Ren)); Enable_If_Packed_Array (Prefix (Ren));
Typ := Etype (First_Index (Etype (Nam))); Typ := Etype (First_Index (Etype (Nam)));
...@@ -451,7 +448,7 @@ package body Exp_Dbug is ...@@ -451,7 +448,7 @@ package body Exp_Dbug is
end case; end case;
end loop; end loop;
-- If we found no reason here to emit an encoding, stop now. -- If we found no reason here to emit an encoding, stop now
if not Enable then if not Enable then
Set_Materialize_Entity (Ent); Set_Materialize_Entity (Ent);
......
...@@ -110,10 +110,9 @@ package body GNAT.Expect is ...@@ -110,10 +110,9 @@ package body GNAT.Expect is
Dead_Process : access Integer; Dead_Process : access Integer;
Is_Set : System.Address) return Integer; Is_Set : System.Address) return Integer;
pragma Import (C, Poll, "__gnat_expect_poll"); pragma Import (C, Poll, "__gnat_expect_poll");
-- Check whether there is any data waiting on the file descriptors -- Check whether there is any data waiting on the file descriptors Fds, and
-- Fds, and wait if there is none, at most Timeout milliseconds -- wait if there is none, at most Timeout milliseconds Returns -1 in case
-- Returns -1 in case of error, 0 if the timeout expired before -- of error, 0 if the timeout expired before data became available.
-- data became available.
-- --
-- Is_Set is an array of the same size as FDs and elements are set to 1 if -- Is_Set is an array of the same size as FDs and elements are set to 1 if
-- data is available for the corresponding File Descriptor, 0 otherwise. -- data is available for the corresponding File Descriptor, 0 otherwise.
......
...@@ -3967,10 +3967,12 @@ package body Ch3 is ...@@ -3967,10 +3967,12 @@ package body Ch3 is
if not Header_Already_Parsed then if not Header_Already_Parsed then
-- NOT NULL ACCESS .. is a common form of access definition. -- NOT NULL ACCESS .. is a common form of access definition.
-- ACCESS NON NULL .. is certainly rare, but syntactically legal. -- ACCESS NOT NULL .. is certainly rare, but syntactically legal.
-- NOT NULL ACCESS NOT NULL .. is rarer yet, and also legal. -- NOT NULL ACCESS NOT NULL .. is rarer yet, and also legal.
-- The last two cases are only meaningful if the following subtype -- The last two cases are only meaningful if the following subtype
-- indication denotes an access type (semantic check). -- indication denotes an access type (semantic check). The flag
-- Not_Null_Subtype indicates that this second null exclusion is
-- present in the access type definition.
Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231) Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
Scan; -- past ACCESS Scan; -- past ACCESS
......
...@@ -1951,9 +1951,17 @@ package body Sem_Ch6 is ...@@ -1951,9 +1951,17 @@ package body Sem_Ch6 is
then then
-- AI05-0151: Tagged incomplete types are allowed in all formal -- AI05-0151: Tagged incomplete types are allowed in all formal
-- parts. Untagged incomplete types are not allowed in bodies. -- parts. Untagged incomplete types are not allowed in bodies.
-- As a consequence, limited views cannot appear in a basic
-- declaration that is itself within a body, because there is
-- no point at which the non-limited view will become visible.
if Ada_Version >= Ada_2012 then if Ada_Version >= Ada_2012 then
if Is_Tagged_Type (Typ) then if From_Limited_With (Typ) and then In_Package_Body then
Error_Msg_NE
("invalid use of incomplete type&",
Result_Definition (N), Typ);
elsif Is_Tagged_Type (Typ) then
null; null;
elsif Nkind (Parent (N)) = N_Subprogram_Body elsif Nkind (Parent (N)) = N_Subprogram_Body
...@@ -11328,10 +11336,10 @@ package body Sem_Ch6 is ...@@ -11328,10 +11336,10 @@ package body Sem_Ch6 is
-- dependents of the type. -- dependents of the type.
if Is_Tagged_Type (Formal_Type) if Is_Tagged_Type (Formal_Type)
or else Ada_Version >= Ada_2012 or else (Ada_Version >= Ada_2012
and then not From_Limited_With (Formal_Type))
then then
if Ekind (Scope (Current_Scope)) = E_Package if Ekind (Scope (Current_Scope)) = E_Package
and then not From_Limited_With (Formal_Type)
and then not Is_Generic_Type (Formal_Type) and then not Is_Generic_Type (Formal_Type)
and then not Is_Class_Wide_Type (Formal_Type) and then not Is_Class_Wide_Type (Formal_Type)
then then
...@@ -11363,13 +11371,19 @@ package body Sem_Ch6 is ...@@ -11363,13 +11371,19 @@ package body Sem_Ch6 is
then then
-- AI05-0151: Tagged incomplete types are allowed in all -- AI05-0151: Tagged incomplete types are allowed in all
-- formal parts. Untagged incomplete types are not allowed -- formal parts. Untagged incomplete types are not allowed
-- in bodies. -- in bodies. Limited views of either kind are not allowed
-- if there is no place at which the non-limited view can
-- become available.
if Ada_Version >= Ada_2012 then if Ada_Version >= Ada_2012 then
if Is_Tagged_Type (Formal_Type) then if Is_Tagged_Type (Formal_Type)
and then (not From_Limited_With (Formal_Type)
or else not In_Package_Body)
then
null; null;
elsif Nkind_In (Parent (Parent (T)), N_Accept_Statement, elsif Nkind_In (Parent (Parent (T)), N_Accept_Statement,
N_Accept_Alternative,
N_Entry_Body, N_Entry_Body,
N_Subprogram_Body) N_Subprogram_Body)
then then
......
...@@ -271,7 +271,7 @@ package body Sem_Elab is ...@@ -271,7 +271,7 @@ package body Sem_Elab is
-- are all continuation messages. The argument is the call node at which -- are all continuation messages. The argument is the call node at which
-- the messages are to be placed. When Check_Elab_Flag is set, calls are -- the messages are to be placed. When Check_Elab_Flag is set, calls are
-- enumerated only when flag Elab_Warning is set for the dynamic case or -- enumerated only when flag Elab_Warning is set for the dynamic case or
-- when flag Elab_Info_Messages is set for the statis case. -- when flag Elab_Info_Messages is set for the static case.
function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean; function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean;
-- Given two scopes, determine whether they are the same scope from an -- Given two scopes, determine whether they are the same scope from an
......
...@@ -1851,7 +1851,9 @@ package Sinfo is ...@@ -1851,7 +1851,9 @@ package Sinfo is
-- to assist in detecting this illegal use of Unrestricted_Access. -- to assist in detecting this illegal use of Unrestricted_Access.
-- Null_Excluding_Subtype (Flag16) -- Null_Excluding_Subtype (Flag16)
-- ??? needs documentation ??? -- Present in N_Access_To_Object_Definition. Indicates that the subtype
-- indication carries a null-exclusion indicator, which is distinct from
-- the null-exclusion indicator that may precede the access keyword.
-- Original_Discriminant (Node2-Sem) -- Original_Discriminant (Node2-Sem)
-- Present in identifiers. Used in references to discriminants that -- Present in identifiers. Used in references to discriminants that
......
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