From c091257074c65f39d9ba23ef191ad9bdf687cbfe Mon Sep 17 00:00:00 2001 From: charlet Date: Wed, 6 Feb 2013 10:35:52 +0000 Subject: [PATCH] 2013-02-06 Robert Dewar * 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 * 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 * sprint.adb (Write_Itype): Treat E_Record_Subtype_With_Private same as E_Record_Subtype. Display E_Class_Wide_Subtype as subtype, not type. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@195797 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 19 +++++++++++++++++++ gcc/ada/comperr.ads | 3 ++- gcc/ada/exp_ch6.adb | 4 +--- gcc/ada/exp_disp.adb | 5 ++++- gcc/ada/osint.ads | 3 ++- gcc/ada/rtsfind.adb | 3 ++- gcc/ada/sem_ch10.adb | 9 ++++----- gcc/ada/sem_ch13.adb | 12 ++++++++++-- gcc/ada/sem_ch3.adb | 14 ++++++++------ gcc/ada/sem_prag.adb | 4 ++++ gcc/ada/sprint.adb | 4 ++-- gcc/ada/targparm.ads | 7 ++++++- 12 files changed, 64 insertions(+), 23 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ccc6b85..d41a8d1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2013-02-06 Robert Dewar + + * 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 + + * 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 + + * 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 * sem_ch3.adb (Complete_Private_Subtype): Inherit the diff --git a/gcc/ada/comperr.ads b/gcc/ada/comperr.ads index a45faf1..ba3cb6b 100644 --- a/gcc/ada/comperr.ads +++ b/gcc/ada/comperr.ads @@ -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 diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index a2caf15..9288e84 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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 diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 5b8ae17..bc4ab50 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -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 diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index 48a7d8e..cbbcd92 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -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 ( diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index ac662f8..5327da5 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -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 diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index e936838..a4241af 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 63c4d08..92df556 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 224a3d9..130cba6 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d72c7d7..1a34b34 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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 --------------- diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 6aa045f..2717350 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -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"); diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index 5869f0c..52a6ee4 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -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 -- -------------------- -- 2.7.4