+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
-- --
-- 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- --
(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
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
-- --
-- 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- --
-- 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
-- --
-- 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- --
-- 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 (
-- --
-- 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- --
-- 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
-- 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;
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;
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.
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.
S2 : constant String_Id := Strval (New_Name);
procedure Mismatch;
+ pragma No_Return (Mismatch);
-- Called if names do not match
--------------
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
---------------
-- Record subtypes
- when E_Record_Subtype =>
+ when E_Record_Subtype | E_Record_Subtype_With_Private =>
Write_Header (False);
Write_Str ("record");
Indent_Begin;
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");
-- --
-- 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- --
-- 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 --
--------------------