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

[multiple changes] 

2013-02-06  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, sem_ch10.adb: Minor reformatting.
	* exp_disp.adb: Minor comment update.
	* comperr.ads, osint.ads, rtsfind.adb, sem_prag.adb: Minor addition of
	No_Return pragmas.

2013-02-06  Thomas Quinot  <quinot@adacore.com>

	* targparm.ads, sem_ch13.adb (Support_Nondefault_SSO): New target
	parameter, defaulted to False for now, indicates targets where
	non-default scalar storage order may be specified.

2013-02-06  Thomas Quinot  <quinot@adacore.com>

	* sprint.adb (Write_Itype): Treat E_Record_Subtype_With_Private
	same as E_Record_Subtype.  Display E_Class_Wide_Subtype as
	subtype, not type.

From-SVN: r195797
This commit is contained in:
Arnaud Charlet 2013-02-06 11:35:52 +01:00
parent 6d840d9980
commit d7761b2d64
12 changed files with 64 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
2013-02-06 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_ch10.adb: Minor reformatting.
* exp_disp.adb: Minor comment update.
* comperr.ads, osint.ads, rtsfind.adb, sem_prag.adb: Minor addition of
No_Return pragmas.
2013-02-06 Thomas Quinot <quinot@adacore.com>
* targparm.ads, sem_ch13.adb (Support_Nondefault_SSO): New target
parameter, defaulted to False for now, indicates targets where
non-default scalar storage order may be specified.
2013-02-06 Thomas Quinot <quinot@adacore.com>
* sprint.adb (Write_Itype): Treat E_Record_Subtype_With_Private
same as E_Record_Subtype. Display E_Class_Wide_Subtype as
subtype, not type.
2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb (Complete_Private_Subtype): Inherit the

3
gcc/ada/comperr.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
@ -33,6 +33,7 @@ package Comperr is
(X : String;
Code : Integer := 0;
Fallback_Loc : String := "");
pragma No_Return (Compiler_Abort);
-- Signals an internal compiler error. Never returns control. Depending on
-- processing may end up raising Unrecoverable_Error, or exiting directly.
-- The message output is a "bug box" containing the first string passed as

4
gcc/ada/exp_ch6.adb
View File

@ -4181,9 +4181,7 @@ package body Exp_Ch6 is
if Is_Entity_Name (N) and then Present (Entity (N)) then
E := Entity (N);
if Is_Formal (E)
and then Scope (E) = Subp
then
if Is_Formal (E) and then Scope (E) = Subp then
A := Renamed_Object (E);
-- Rewrite the occurrence of the formal into an occurrence of

5
gcc/ada/exp_disp.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
@ -4132,6 +4132,9 @@ package body Exp_Disp is
-- Nb_Prim. If the tagged type has no primitives we add a dummy
-- slot whose address will be the tag of this type.
-- ???codepeer???
-- Nb_Prim cannot be zero here, so this test is wrong
if Nb_Prim = 0 then
New_Node := Make_Integer_Literal (Loc, 1);
else

3
gcc/ada/osint.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
@ -637,6 +637,7 @@ package Osint is
-- Set_Exit_Status as the last action of the program.
procedure OS_Exit_Through_Exception (Status : Integer);
pragma No_Return;
-- Set the Current_Exit_Status, then raise Types.Terminate_Program
type Exit_Code_Type is (

3
gcc/ada/rtsfind.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2013, 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- --
@ -148,6 +148,7 @@ package body Rtsfind is
-- value in RTU_Id.
procedure Load_Fail (S : String; U_Id : RTU_Id; Id : RE_Id);
pragma No_Return (Load_Fail);
-- Internal procedure called if we can't successfully locate or process a
-- run-time unit. The parameters give information about the error message
-- to be given. S is a reason for failing to compile the file and U_Id is

9
gcc/ada/sem_ch10.adb
View File

@ -4741,11 +4741,10 @@ package body Sem_Ch10 is
-- compiling the body of the child unit.
if P = Cunit_Entity (Current_Sem_Unit)
or else
(Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body
and then P = Main_Unit_Entity
and then
Is_Ancestor_Unit (Cunit (Main_Unit), Cunit (Current_Sem_Unit)))
or else (Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body
and then P = Main_Unit_Entity
and then Is_Ancestor_Unit
(Cunit (Main_Unit), Cunit (Current_Sem_Unit)))
then
return;
end if;

12
gcc/ada/sem_ch13.adb
View File

@ -3622,9 +3622,17 @@ package body Sem_Ch13 is
Flag_Non_Static_Expr
("Scalar_Storage_Order requires static expression!", Expr);
else
if (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then
elsif (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then
-- Here for the case of a non-default (i.e. non-confirming)
-- Scalar_Storage_Order attribute definition.
if Support_Nondefault_SSO_On_Target then
Set_Reverse_Storage_Order (Base_Type (U_Ent), True);
else
Error_Msg_N
("non-default Scalar_Storage_Order "
& "not supported on target", Expr);
end if;
end if;
end if;

14
gcc/ada/sem_ch3.adb
View File

@ -10255,21 +10255,23 @@ package body Sem_Ch3 is
Protected_Kind =>
Copy_Node (Priv, Full);
Set_Has_Discriminants (Full, Has_Discriminants (Full_Base));
Set_Has_Discriminants
(Full, Has_Discriminants (Full_Base));
Set_Has_Unknown_Discriminants
(Full, Has_Unknown_Discriminants (Full_Base));
Set_First_Entity (Full, First_Entity (Full_Base));
Set_Last_Entity (Full, Last_Entity (Full_Base));
(Full, Has_Unknown_Discriminants (Full_Base));
Set_First_Entity (Full, First_Entity (Full_Base));
Set_Last_Entity (Full, Last_Entity (Full_Base));
when others =>
Copy_Node (Full_Base, Full);
Set_Chars (Full, Chars (Priv));
Conditional_Delay (Full, Priv);
Set_Sloc (Full, Sloc (Priv));
end case;
Set_Next_Entity (Full, Save_Next_Entity);
Set_Homonym (Full, Save_Homonym);
Set_Next_Entity (Full, Save_Next_Entity);
Set_Homonym (Full, Save_Homonym);
Set_Associated_Node_For_Itype (Full, Related_Nod);
-- Set common attributes for all subtypes: kind, convention, etc.

4
gcc/ada/sem_prag.adb
View File

@ -1924,6 +1924,7 @@ package body Sem_Prag is
procedure Check_Loop_Invariant_Variant_Placement is
procedure Placement_Error (Constr : Node_Id);
pragma No_Return (Placement_Error);
-- Node Constr denotes the last loop restricted construct before we
-- encountered an illegal relation between enclosing constructs. Emit
-- an error depending on what Constr was.
@ -6049,6 +6050,7 @@ package body Sem_Prag is
S2 : constant String_Id := Strval (New_Name);
procedure Mismatch;
pragma No_Return (Mismatch);
-- Called if names do not match
--------------
@ -6154,9 +6156,11 @@ package body Sem_Prag is
Mech_Name_Id : Name_Id;
procedure Bad_Class;
pragma No_Return (Bad_Class);
-- Signal bad descriptor class name
procedure Bad_Mechanism;
pragma No_Return (Bad_Mechanism);
-- Signal bad mechanism name
---------------

4
gcc/ada/sprint.adb
View File

@ -4145,7 +4145,7 @@ package body Sprint is
-- Record subtypes
when E_Record_Subtype =>
when E_Record_Subtype | E_Record_Subtype_With_Private =>
Write_Header (False);
Write_Str ("record");
Indent_Begin;
@ -4170,7 +4170,7 @@ package body Sprint is
when E_Class_Wide_Type |
E_Class_Wide_Subtype =>
Write_Header;
Write_Header (Ekind (Typ) = E_Class_Wide_Type);
Write_Name_With_Col_Check (Chars (Etype (Typ)));
Write_Str ("'Class");

7
gcc/ada/targparm.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2013, 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- --
@ -436,6 +436,11 @@ package Targparm is
-- the source program may not contain explicit 64-bit shifts. In addition,
-- the code generated for packed arrays will avoid the use of long shifts.
Support_Nondefault_SSO_On_Target : Boolean := False;
-- If True, the back end supports the non-default Scalar_Storage_Order
-- (i.e. allows non-confirming Scalar_Storage_Order attribute definition
-- clauses).
--------------------
-- Indirect Calls --
--------------------