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

[multiple changes] 

2011-08-04  Robert Dewar  <dewar@adacore.com>

	* sem_aggr.adb, par_sco.adb, sem_type.adb, exp_util.adb, exp_ch9.adb,
	prj-nmsc.adb, sem_ch13.adb, exp_strm.adb: Minor reformatting.

2011-08-04  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Minor documentation fix for pragma Annotate.

2011-08-04  Yannick Moy  <moy@adacore.com>

	* sem_attr.adb (Analyze_Attribute): add check during pre-analysis that
	'Result only appears in postcondition of function.

2011-08-04  Thomas Quinot  <quinot@adacore.com>

	* a-tags.adb (Check_TSD): When raising PROGRAM_ERROR for a duplicated
	external tag, include the value of the external tag in the exception
	message.

From-SVN: r177344
This commit is contained in:
Arnaud Charlet 2011-08-04 11:42:31 +02:00
parent 0180fd267e
commit fe0ec02f93
12 changed files with 84 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

@ -1,3 +1,23 @@
2011-08-04 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb, par_sco.adb, sem_type.adb, exp_util.adb, exp_ch9.adb,
prj-nmsc.adb, sem_ch13.adb, exp_strm.adb: Minor reformatting.
2011-08-04 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Minor documentation fix for pragma Annotate.
2011-08-04 Yannick Moy <moy@adacore.com>
* sem_attr.adb (Analyze_Attribute): add check during pre-analysis that
'Result only appears in postcondition of function.
2011-08-04 Thomas Quinot <quinot@adacore.com>
* a-tags.adb (Check_TSD): When raising PROGRAM_ERROR for a duplicated
external tag, include the value of the external tag in the exception
message.
2011-08-04 Yannick Moy <moy@adacore.com>
* sem_attr.adb (Result): modify error message for misplaced 'Result

11
gcc/ada/a-tags.adb
View File

@ -310,6 +310,13 @@ package body Ada.Tags is
procedure Check_TSD (TSD : Type_Specific_Data_Ptr) is
T : Tag;
E_Tag_Len : constant Integer := Length (TSD.External_Tag);
E_Tag : String (1 .. E_Tag_Len);
for E_Tag'Address use TSD.External_Tag.all'Address;
pragma Import (Ada, E_Tag);
-- Start of processing for Check_TSD
begin
-- Verify that the external tag of this TSD is not registered in the
-- runtime hash table.
@ -317,7 +324,7 @@ package body Ada.Tags is
T := External_Tag_HTable.Get (To_Address (TSD.External_Tag));
if T /= null then
raise Program_Error with "duplicated external tag";
raise Program_Error with "duplicated external tag " & E_Tag;
end if;
end Check_TSD;
@ -718,6 +725,8 @@ package body Ada.Tags is
-- Length --
------------
-- Should this be reimplemented using the strlen GCC builtin???
function Length (Str : Cstring_Ptr) return Natural is
Len : Integer;

3
gcc/ada/exp_ch9.adb
View File

@ -949,8 +949,7 @@ package body Exp_Ch9 is
if Opt.Suppress_Control_Flow_Optimizations then
Stmt := Make_Implicit_If_Statement (Cond,
Condition =>
Cond,
Condition => Cond,
Then_Statements => New_List (
Make_Simple_Return_Statement (Loc,
New_Occurrence_Of (Standard_True, Loc))),

16
gcc/ada/exp_strm.adb
View File

@ -203,6 +203,7 @@ package body Exp_Strm is
Make_Object_Declaration (Loc,
Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
Object_Definition => New_Occurrence_Of (Typ, Loc));
else
Odecl :=
Make_Object_Declaration (Loc,
@ -270,10 +271,10 @@ package body Exp_Strm is
for J in 1 .. Number_Dimensions (Typ) loop
Append_To (Stms,
Make_Attribute_Reference (Loc,
Prefix =>
Prefix =>
New_Occurrence_Of (Stream_Base_Type (Etype (Indx)), Loc),
Attribute_Name => Name_Write,
Expressions => New_List (
Expressions => New_List (
Make_Identifier (Loc, Name_S),
Make_Attribute_Reference (Loc,
Prefix => Make_Identifier (Loc, Name_V),
@ -283,10 +284,10 @@ package body Exp_Strm is
Append_To (Stms,
Make_Attribute_Reference (Loc,
Prefix =>
Prefix =>
New_Occurrence_Of (Stream_Base_Type (Etype (Indx)), Loc),
Attribute_Name => Name_Write,
Expressions => New_List (
Expressions => New_List (
Make_Identifier (Loc, Name_S),
Make_Attribute_Reference (Loc,
Prefix => Make_Identifier (Loc, Name_V),
@ -301,7 +302,7 @@ package body Exp_Strm is
Append_To (Stms,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Typ, Loc),
Prefix => New_Occurrence_Of (Typ, Loc),
Attribute_Name => Name_Write,
Expressions => New_List (
Make_Identifier (Loc, Name_S),
@ -566,6 +567,10 @@ package body Exp_Strm is
-- then the representation is unsigned
elsif not Is_Unsigned_Type (FST)
-- The following set of tests gets repeated many times, we should
-- have an abstraction defined ???
and then
(Is_Fixed_Point_Type (U_Type)
or else
@ -573,6 +578,7 @@ package body Exp_Strm is
or else
(Is_Signed_Integer_Type (U_Type)
and then not Has_Biased_Representation (FST)))
then
if P_Size <= Standard_Short_Short_Integer_Size then
Lib_RE := RE_I_SSI;

7
gcc/ada/exp_util.adb
View File

@ -3888,13 +3888,13 @@ package body Exp_Util is
N_Selected_Component)
then
Ren_Obj := Prefix (Ren_Obj);
Change := True;
Change := True;
elsif Nkind_In (Ren_Obj, N_Type_Conversion,
N_Unchecked_Type_Conversion)
then
Ren_Obj := Expression (Ren_Obj);
Change := True;
Change := True;
end if;
end loop;
@ -3909,8 +3909,7 @@ package body Exp_Util is
begin
-- If a previous invocation of this routine has determined that a
-- list has no renamings, there is no point in repeating the same
-- scan.
-- list has no renamings, then no point in repeating the same scan.
if not Has_Rens then
return False;

7
gcc/ada/gnat_rm.texi
View File

@ -1003,8 +1003,11 @@ All other kinds of arguments are analyzed as expressions, and must be
unambiguous.
The analyzed pragma is retained in the tree, but not otherwise processed
by any part of the GNAT compiler. This pragma is intended for use by
external tools, including ASIS@.
by any part of the GNAT compiler, except to generate corresponding note
lines in the generated ALI file. For the format of these note lines, see
the compiler source file lib-writ.ads. This pragma is intended for use by
external tools, including ASIS@. The use of pragma Annotate does not
affect the compilation process in any way.
@node Pragma Assert
@unnumberedsec Pragma Assert

2
gcc/ada/par_sco.adb
View File

@ -575,7 +575,7 @@ package body Par_SCO is
when N_Case_Expression =>
return OK; -- ???
-- Conditional expression, processed like an IF statement
-- Conditional expression, processed like an if statement
when N_Conditional_Expression =>
declare

3
gcc/ada/prj-nmsc.adb
View File

@ -7820,8 +7820,7 @@ package body Prj.Nmsc is
begin
Debug_Output ("Path_Name_Of file_name=", Name_Id (File_Name));
Debug_Output ("Path_Name_Of directory=",
Name_Id (Directory));
Debug_Output ("Path_Name_Of directory=", Name_Id (Directory));
Get_Name_String (File_Name);
Result :=
Locate_Regular_File

1
gcc/ada/sem_aggr.adb
View File

@ -997,6 +997,7 @@ package body Sem_Aggr is
Insert_Actions (N, Freeze_Entity (Typ, N));
exit;
end if;
Next (Comp);
end loop;
end;

20
gcc/ada/sem_attr.adb
View File

@ -3990,6 +3990,9 @@ package body Sem_Attr is
-- source subprogram to which the postcondition applies. During
-- pre-analysis, CS is the scope of the subprogram declaration.
Prag : Node_Id;
-- During pre-analysis, Prag is the enclosing pragma node if any
begin
-- Find enclosing scopes, excluding loops
@ -4029,6 +4032,23 @@ package body Sem_Attr is
Error_Attr;
end if;
-- Check in postcondition of function
Prag := N;
while not Nkind_In (Prag, N_Pragma, N_Function_Specification,
N_Subprogram_Body)
loop
Prag := Parent (Prag);
end loop;
if Nkind (Prag) /= N_Pragma
or else Get_Pragma_Id (Prag) /= Pragma_Postcondition
then
Error_Attr
("% attribute can only appear in postcondition of function",
P);
end if;
-- The attribute reference is a primary. If expressions follow,
-- the attribute reference is really an indexable object, so
-- rewrite and analyze as an indexed component.

8
gcc/ada/sem_ch13.adb
View File

@ -4228,10 +4228,10 @@ package body Sem_Ch13 is
Arg1 := Get_Pragma_Arg (Arg1);
Arg2 := Get_Pragma_Arg (Arg2);
-- See if this predicate pragma is for the current type
-- or for its full view. A predicate on a private completion
-- is placed on the partial view beause this is the visible
-- entity that is frozen..
-- See if this predicate pragma is for the current type or for
-- its full view. A predicate on a private completion is placed
-- on the partial view beause this is the visible entity that
-- is frozen.
if Entity (Arg1) = Typ
or else Full_View (Entity (Arg1)) = Typ

12
gcc/ada/sem_type.adb
View File

@ -1208,7 +1208,7 @@ package body Sem_Type is
function Operand_Type return Entity_Id;
-- Determine type of operand for an equality operation, to apply
-- Ada2005 rules to equality on anonymous access types.
-- Ada 2005 rules to equality on anonymous access types.
function Standard_Operator return Boolean;
-- Check whether subprogram is predefined operator declared in Standard.
@ -1287,14 +1287,15 @@ package body Sem_Type is
function Operand_Type return Entity_Id is
Opnd : Node_Id;
begin
if Nkind (N) = N_Function_Call then
Opnd := First_Actual (N);
else
Opnd := Left_Opnd (N);
end if;
return Etype (Opnd);
return Etype (Opnd);
end Operand_Type;
------------------------
@ -1927,14 +1928,14 @@ package body Sem_Type is
-- may be an operator or a function call.
elsif (Chars (Nam1) = Name_Op_Eq
or else
Chars (Nam1) = Name_Op_Ne)
or else
Chars (Nam1) = Name_Op_Ne)
and then Ada_Version >= Ada_2005
and then Etype (User_Subp) = Standard_Boolean
and then Ekind (Operand_Type) = E_Anonymous_Access_Type
and then
In_Same_List (Parent (Designated_Type (Operand_Type)),
Unit_Declaration_Node (User_Subp))
Unit_Declaration_Node (User_Subp))
then
if It2.Nam = Predef_Subp then
return It1;
@ -2675,6 +2676,7 @@ package body Sem_Type is
end if;
Par := Etype (Full_View (BT2));
else
Par := Etype (BT2);
end if;