+2015-10-16 Javier Miranda <miranda@adacore.com>
+
+ * inline.adb (Add_Inlined_Body): Ensure that
+ Analyze_Inlined_Bodies will be invoked after completing the
+ analysis of the current unit.
+
+2015-10-16 Arnaud Charlet <charlet@adacore.com>
+
+ * sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Fix error
+ message for bad last bit position.
+ * sem_ch3.adb, sem_util.adb, sem_util.ads: Minor reformatting.
+
+2015-10-16 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch5.adb (Expand_N_Case_Statement): If expression is
+ compile-time known but does not obey a static predicate on
+ its type, replace the case statement with a raise statement,
+ as with other statically detected constraint violations.
+
+2015-10-16 Bob Duff <duff@adacore.com>
+
+ * s-traceb.adb, s-traceb.ads, s-traceb-hpux.adb, s-traceb-mastop.adb:
+ Reinstate code.
+ * opt.ads: Minor typo.
+
2015-10-16 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Gather_Components): When gathering components
-- If the value is static but its subtype is predicated and the value
-- does not obey the predicate, the value is marked non-static, and
- -- there can be no corresponding static alternative.
+ -- there can be no corresponding static alternative. In that case we
+ -- replace the case statement with an exception, regardless of whether
+ -- assertions are enabled or not.
if Compile_Time_Known_Value (Expr)
+ and then Has_Predicates (Etype (Expr))
+ and then not Is_OK_Static_Expression (Expr)
+ then
+ Rewrite (N,
+ Make_Raise_Constraint_Error (Loc, Reason => CE_Invalid_Data));
+ Analyze (N);
+ return;
+
+ elsif Compile_Time_Known_Value (Expr)
and then (not Has_Predicates (Etype (Expr))
or else Is_Static_Expression (Expr))
then
Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
begin
+ -- Ensure that Analyze_Inlined_Bodies will be invoked after
+ -- completing the analysis of the current unit.
+
+ Inline_Processing_Required := True;
+
if Pack = E then
-- Library-level inlined function. Add function itself to
-- be inlined in GNATprove mode.
Init_Or_Norm_Scalars : Boolean := False;
- -- GNAT, GANTBIND
+ -- GNAT, GNATBIND
-- Set True if a pragma Initialize_Scalars applies to the current unit.
-- Also set True if a pragma Restriction (Normalize_Scalars) applies.
-- --
-- B o d y --
-- --
--- Copyright (C) 2009-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2015, 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- --
-- but it is not usable when frames with dynamically allocated space are
-- on the way.
--- procedure Call_Chain
--- (Traceback : System.Address;
--- Max_Len : Natural;
--- Len : out Natural;
--- Exclude_Min : System.Address := System.Null_Address;
--- Exclude_Max : System.Address := System.Null_Address;
--- Skip_Frames : Natural := 1);
--- -- Same as the exported version, but takes Traceback as an Address
--- ???See declaration in the spec for why this is temporarily commented out.
+ procedure Call_Chain
+ (Traceback : System.Address;
+ Max_Len : Natural;
+ Len : out Natural;
+ Exclude_Min : System.Address := System.Null_Address;
+ Exclude_Max : System.Address := System.Null_Address;
+ Skip_Frames : Natural := 1);
+ -- Same as the exported version, but takes Traceback as an Address
------------------
-- C_Call_Chain --
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2014, AdaCore --
+-- Copyright (C) 1999-2015, AdaCore --
-- --
-- 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- --
use System.Machine_State_Operations;
--- procedure Call_Chain
--- (Traceback : System.Address;
--- Max_Len : Natural;
--- Len : out Natural;
--- Exclude_Min : System.Address := System.Null_Address;
--- Exclude_Max : System.Address := System.Null_Address;
--- Skip_Frames : Natural := 1);
--- -- Same as the exported version, but takes Traceback as an Address
--- ???See declaration in the spec for why this is temporarily commented out.
+ procedure Call_Chain
+ (Traceback : System.Address;
+ Max_Len : Natural;
+ Len : out Natural;
+ Exclude_Min : System.Address := System.Null_Address;
+ Exclude_Max : System.Address := System.Null_Address;
+ Skip_Frames : Natural := 1);
+ -- Same as the exported version, but takes Traceback as an Address
----------------
-- Call_Chain --
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2015, 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- --
package body System.Traceback is
+ procedure Call_Chain
+ (Traceback : System.Address;
+ Max_Len : Natural;
+ Len : out Natural;
+ Exclude_Min : System.Address := System.Null_Address;
+ Exclude_Max : System.Address := System.Null_Address;
+ Skip_Frames : Natural := 1);
+ -- Same as the exported version, but takes Traceback as an Address
+
------------------
-- C_Call_Chain --
------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2015, 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- --
-- number of stored entries. The first entry is the most recent call,
-- and the last entry is the highest level call.
- procedure Call_Chain
- (Traceback : System.Address;
- Max_Len : Natural;
- Len : out Natural;
- Exclude_Min : System.Address := System.Null_Address;
- Exclude_Max : System.Address := System.Null_Address;
- Skip_Frames : Natural := 1);
- -- Same as the previous version, but takes Traceback as an Address. The
- -- previous version is preferred. ???This version should be removed from
- -- this spec, and calls replaced with calls to the previous version. This
- -- declaration can be moved to the bodies (s-traceb.adb, s-traceb-hpux.adb,
- -- and s-traceb-mastop.adb), but it should not be visible to clients.
-
function C_Call_Chain
(Traceback : System.Address;
Max_Len : Natural) return Natural;
("machine scalar rules not followed for&",
First_Bit (CC), Comp);
- Error_Msg_Uint_1 := Lbit;
+ Error_Msg_Uint_1 := Lbit + 1;
Error_Msg_Uint_2 := Max_Machine_Scalar_Size;
Error_Msg_F
- ("\last bit (^) exceeds maximum machine "
+ ("\last bit + 1 (^) exceeds maximum machine "
& "scalar size (^)",
First_Bit (CC));
Error_Msg_Uint_1 := SSU;
Error_Msg_F
("\and is not a multiple of Storage_Unit (^) "
- & "(RM 13.4.1(10))",
+ & "(RM 13.5.1(10))",
First_Bit (CC));
else
(C : Entity_Id;
N : Node_Id := Empty) return Boolean
is
- Original_Comp : Entity_Id := Empty;
+ Original_Comp : Entity_Id := Empty;
Original_Type : Entity_Id;
- Type_Scope : Entity_Id;
+ Type_Scope : Entity_Id;
function Is_Local_Type (Typ : Entity_Id) return Boolean;
-- Check whether parent type of inherited component is declared locally,
if Ancestor = Original_Type then
return True;
- -- The ancestor may have a partial view of the original
- -- type, but if the full view is in scope, as in a child
- -- body, the component is visible.
+ -- The ancestor may have a partial view of the original type,
+ -- but if the full view is in scope, as in a child body, the
+ -- component is visible.
elsif In_Private_Part (Scope (Original_Type))
and then Full_View (Ancestor) = Original_Type
elsif Ancestor = Etype (Ancestor) then
- -- No further ancestors to examine.
+ -- No further ancestors to examine
return False;
end if;
-- This shouldn't be necessary, but without this check, we crash in
-- gimplify. ???
+ ------------------------------
+ -- Caller_Known_Size_Record --
+ ------------------------------
+
function Caller_Known_Size_Record (Typ : Entity_Id) return Boolean is
pragma Assert (Typ = Underlying_Type (Typ));
end if;
declare
- Comp : Entity_Id := First_Entity (Typ);
+ Comp : Entity_Id;
begin
+ Comp := First_Entity (Typ);
while Present (Comp) loop
-- Only look at E_Component entities. No need to look at
return True;
end Caller_Known_Size_Record;
+ ---------------------------
+ -- Has_Discrim_Dep_Array --
+ ---------------------------
+
function Has_Discrim_Dep_Array (Typ : Entity_Id) return Boolean is
pragma Assert (Typ = Underlying_Type (Typ));
end if;
if Is_Record_Type (Typ)
- or else
- Is_Protected_Type (Typ)
+ or else
+ Is_Protected_Type (Typ)
then
declare
- Comp : Entity_Id := First_Entity (Typ);
+ Comp : Entity_Id;
begin
+ Comp := First_Entity (Typ);
while Present (Comp) loop
-- Only look at E_Component entities. No need to look at
declare
Comp_Type : constant Entity_Id :=
Underlying_Type (Etype (Comp));
-
begin
if Has_Discrim_Dep_Array (Comp_Type) then
return True;
-- returned. Otherwise the Etype of the node is returned.
function Get_Body_From_Stub (N : Node_Id) return Node_Id;
- -- Return the body node for a stub.
+ -- Return the body node for a stub
function Get_Cursor_Type
(Aspect : Node_Id;
projects / gcc.git / commitdiff