Skip to content

R
riscv-gcc-1
Commit 4b7fd131 by Arnaud Charlet
Options

[multiple changes] 

2017-01-23  Justin Squirek  <squirek@adacore.com>

	* exp_strm.ads, exp_strm.ads
	(Build_Record_Or_Elementary_Input_Function): Add an extra parameter so
	as to avoid getting the underlying type by default.
	* exp_attr.adb (Expand_N_Attribute_Reference): Remove use of
	underlying type in the Iiput and output attribute cases when
	building their respective functions.

2017-01-23  Gary Dismukes  <dismukes@adacore.com>

	* scng.adb: Minor reformatting of error message.

2017-01-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): Do not attempt
	to freeze the return type of an expression funxtion that is a
	completion, if the type is a limited view and the non-limited
	view is available.

From-SVN: r244805
parent cffcafda
Showing with 96 additions and 43 deletions
gcc/ada/ChangeLog
2017-01-23 Justin Squirek <squirek@adacore.com>
* exp_strm.ads, exp_strm.ads
(Build_Record_Or_Elementary_Input_Function): Add an extra parameter so
as to avoid getting the underlying type by default.
* exp_attr.adb (Expand_N_Attribute_Reference): Remove use of
underlying type in the Iiput and output attribute cases when
building their respective functions.
2017-01-23 Gary Dismukes <dismukes@adacore.com>
* scng.adb: Minor reformatting of error message.
2017-01-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): Do not attempt
to freeze the return type of an expression funxtion that is a
completion, if the type is a limited view and the non-limited
view is available.
2017-01-23 Ed Schonberg <schonberg@adacore.com>
* par-ch4.adb (P_Aggregate_Or_Parent_Expr): Recognize delta
......
gcc/ada/exp_attr.adb
......@@ -3744,18 +3744,26 @@ package body Exp_Attr is
-- A special case arises if we have a defined _Read routine,
-- since in this case we are required to call this routine.
if Present (TSS (Base_Type (U_Type), TSS_Stream_Read)) then
Build_Record_Or_Elementary_Input_Function
(Loc, U_Type, Decl, Fname);
Insert_Action (N, Decl);
declare
Typ : Entity_Id := P_Type;
begin
if Present (Full_View (Typ)) then
Typ := Full_View (Typ);
end if;
-- For normal cases, we call the I_xxx routine directly
if Present (TSS (Base_Type (Typ), TSS_Stream_Read)) then
Build_Record_Or_Elementary_Input_Function
(Loc, Typ, Decl, Fname, Use_Underlying => False);
Insert_Action (N, Decl);
else
Rewrite (N, Build_Elementary_Input_Call (N));
Analyze_And_Resolve (N, P_Type);
return;
end if;
-- For normal cases, we call the I_xxx routine directly
else
Rewrite (N, Build_Elementary_Input_Call (N));
Analyze_And_Resolve (N, P_Type);
return;
end if;
end;
-- Array type case
......@@ -4839,18 +4847,26 @@ package body Exp_Attr is
-- A special case arises if we have a defined _Write routine,
-- since in this case we are required to call this routine.
if Present (TSS (Base_Type (U_Type), TSS_Stream_Write)) then
Build_Record_Or_Elementary_Output_Procedure
(Loc, U_Type, Decl, Pname);
Insert_Action (N, Decl);
declare
Typ : Entity_Id := P_Type;
begin
if Present (Full_View (Typ)) then
Typ := Full_View (Typ);
end if;
-- For normal cases, we call the W_xxx routine directly
if Present (TSS (Base_Type (Typ), TSS_Stream_Write)) then
Build_Record_Or_Elementary_Output_Procedure
(Loc, Typ, Decl, Pname);
Insert_Action (N, Decl);
else
Rewrite (N, Build_Elementary_Write_Call (N));
Analyze (N);
return;
end if;
-- For normal cases, we call the W_xxx routine directly
else
Rewrite (N, Build_Elementary_Write_Call (N));
Analyze (N);
return;
end if;
end;
-- Array type case
......
gcc/ada/exp_strm.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
......@@ -1116,23 +1116,28 @@ package body Exp_Strm is
-- an elementary type, then no Cn constants are defined.
procedure Build_Record_Or_Elementary_Input_Function
(Loc : Source_Ptr;
Typ : Entity_Id;
Decl : out Node_Id;
Fnam : out Entity_Id)
(Loc : Source_Ptr;
Typ : Entity_Id;
Decl : out Node_Id;
Fnam : out Entity_Id;
Use_Underlying : Boolean := True)
is
B_Typ : constant Entity_Id := Underlying_Type (Base_Type (Typ));
B_Typ : Entity_Id := Base_Type (Typ);
Cn : Name_Id;
Constr : List_Id;
Decls : List_Id;
Discr : Entity_Id;
Discr_Elmt : Elmt_Id := No_Elmt;
Discr_Elmt : Elmt_Id := No_Elmt;
J : Pos;
Obj_Decl : Node_Id;
Odef : Node_Id;
Stms : List_Id;
begin
if Use_Underlying then
B_Typ := Underlying_Type (B_Typ);
end if;
Decls := New_List;
Constr := New_List;
......
gcc/ada/exp_strm.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2016, 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- --
......@@ -105,14 +105,17 @@ package Exp_Strm is
-- the same manner as is done for 'Output.
procedure Build_Record_Or_Elementary_Input_Function
(Loc : Source_Ptr;
Typ : Entity_Id;
Decl : out Node_Id;
Fnam : out Entity_Id);
-- Build function for Input attribute for record type or for an
-- elementary type (the latter is used only in the case where a
-- user defined Read routine is defined, since in other cases,
-- Input calls the appropriate runtime library routine directly.
(Loc : Source_Ptr;
Typ : Entity_Id;
Decl : out Node_Id;
Fnam : out Entity_Id;
Use_Underlying : Boolean := True);
-- Build function for Input attribute for record type or for an elementary
-- type (the latter is used only in the case where a user defined Read
-- routine is defined, since in other cases, Input calls the appropriate
-- runtime library routine directly. The flag Use_Underlying controls
-- weither the base type or the underlying type of the base type of Typ is
-- used during construction.
procedure Build_Record_Or_Elementary_Output_Procedure
(Loc : Source_Ptr;
......
gcc/ada/scng.adb
......@@ -1613,7 +1613,7 @@ package body Scng is
when '@' =>
if Ada_Version < Ada_2020 then
Error_Msg ("target_name is an Ada2020 feature", Scan_Ptr);
Error_Msg ("target_name is an Ada 2020 feature", Scan_Ptr);
Scan_Ptr := Scan_Ptr + 1;
else
......
gcc/ada/sem_ch6.adb
......@@ -381,17 +381,26 @@ package body Sem_Ch6 is
-- An entity can only be frozen if it is complete, so if the type
-- is still unfrozen it must still be incomplete in some way, e.g.
-- a privte type without a full view, or a type derived from such
-- in an enclosing scope. Except in a generic context, such an
-- incomplete type is an error.
-- a private type without a full view, or a type derived from such
-- in an enclosing scope. Except in a generic context, such use of
-- an incomplete type is an error. On the other hand, if this is a
-- limited view of a type, the type is declared in another unit and
-- frozen there. We must be in a context seeing the nonlimited view
-- of the type, which will be installed when the body is compiled.
if not Is_Frozen (Ret_Type)
and then not Is_Generic_Type (Ret_Type)
and then not Inside_A_Generic
then
Error_Msg_NE
("premature use of private type&",
Result_Definition (Specification (N)), Ret_Type);
if From_Limited_With (Ret_Type)
and then Present (Non_Limited_View (Ret_Type))
then
null;
else
Error_Msg_NE
("premature use of private type&",
Result_Definition (Specification (N)), Ret_Type);
end if;
end if;
if Is_Access_Type (Etype (Prev)) then
......
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