+2014-07-29 Ed Schonberg <schonberg@adacore.com>
+
+ * inline.ads, inline.adb, sem_ch10.adb: Rename Check_Body_For_Inlining
+ to Check_Package_Body_For_Inlining, to prevent confusion with other
+ inlining subprograms.
+
+2014-07-29 Robert Dewar <dewar@adacore.com>
+
+ * opt.ads: Minor comment update.
+ * sem_attr.adb (Uneval_Old_Msg): Deal with case of aspect, where
+ we want setting of Uneval_Old at time of encountering the aspect.
+ * sem_ch13.adb (Analyze_Aspect_Specifications): Capture setting
+ of Opt.Uneval_Old.
+ * sinfo.adb (Uneval_Old_Accept): New function (Uneval_Old_Warn):
+ New function (Set_Uneval_Old_Accept): New procedure.
+ (Set_Uneval_Old_Warn): New procedure.
+ * sinfo.ads: Uneval_Old_Accept: New flag Uneval_Old_Warn: New flag.
+
2014-07-29 Robert Dewar <dewar@adacore.com>
* sinfo.ads, inline.adb, inline.ads, sem_ch6.adb: Minor reformatting.
end if;
end Check_And_Build_Body_To_Inline;
- -----------------------------
- -- Check_Body_For_Inlining --
- -----------------------------
+ -------------------------------------
+ -- Check_Package_Body_For_Inlining --
+ -------------------------------------
- procedure Check_Body_For_Inlining (N : Node_Id; P : Entity_Id) is
+ procedure Check_Package_Body_For_Inlining (N : Node_Id; P : Entity_Id) is
Bname : Unit_Name_Type;
E : Entity_Id;
OK : Boolean;
Next_Entity (E);
end loop;
end if;
- end Check_Body_For_Inlining;
+ end Check_Package_Body_For_Inlining;
--------------------
-- Cleanup_Scopes --
-- If a subprogram has pragma Inline and inlining is active, use generic
-- machinery to build an unexpanded body for the subprogram. This body is
-- subsequently used for inline expansions at call sites. If subprogram can
- -- be inlined (depending on size and nature of local declarations) this
- -- function returns true. Otherwise subprogram body is treated normally.
- -- If proper warnings are enabled and the subprogram contains a construct
- -- that cannot be inlined, the offending construct is flagged accordingly.
+ -- be inlined (depending on size and nature of local declarations) the
+ -- template body is created. Otherwise subprogram body is treated normally
+ -- and calls are not inlined in the frontend. If proper warnings are
+ -- enabled and the subprogram contains a construct that cannot be inlined,
+ -- the problematic construct is flagged accordingly.
procedure Cannot_Inline
(Msg : String;
-- cases documented in Check_Body_To_Inline) then build the body-to-inline
-- associated with N and attach it to the declaration node of Spec_Id.
- procedure Check_Body_For_Inlining (N : Node_Id; P : Entity_Id);
+ procedure Check_Package_Body_For_Inlining (N : Node_Id; P : Entity_Id);
-- If front-end inlining is enabled and a package declaration contains
-- inlined subprograms, load and compile the package body to collect the
-- bodies of these subprograms, so they are available to inline calls.
Uneval_Old : Character := 'E';
-- GNAT
-- Set to 'E'/'W'/'A' for use of Error/Warn/Allow in a valid pragma
- -- Unevaluated_Use_Of_Old.
+ -- Unevaluated_Use_Of_Old. Default in the absence of the pragma is 'E'
+ -- for the RM default behavior of giving an error.
Unique_Error_Tag : Boolean := Tag_Errors;
-- GNAT
procedure Uneval_Old_Msg;
-- Called when Loop_Entry or Old is used in a potentially unevaluated
-- expression. Generates appropriate message or warning depending on
- -- the setting of Opt.Uneval_Old.
+ -- the setting of Opt.Uneval_Old (or flags in an N_Aspect_Specification
+ -- node in the aspect case).
procedure Unexpected_Argument (En : Node_Id);
-- Signal unexpected attribute argument (En is the argument)
--------------------
procedure Uneval_Old_Msg is
+ Uneval_Old_Setting : Character := Opt.Uneval_Old;
+ Prag : Node_Id;
+
begin
- case Uneval_Old is
+ -- If from aspect, then Uneval_Old_Setting comes from flags in the
+ -- N_Aspect_Specification node that corresponds to the attribute.
+
+ -- First find the pragma in which we appear (note that at this stage,
+ -- even if we appeared originally within an aspect specification, we
+ -- are now within the corresponding pragma).
+
+ Prag := N;
+ loop
+ Prag := Parent (Prag);
+ exit when No (Prag) or else Nkind (Prag) = N_Pragma;
+ end loop;
+
+ -- If we did not find the pragma, that's odd, just consider it a
+ -- case where we use Opt.Uneval_Old for further processing. Perhaps
+ -- this can come from some previous error.
+
+ if Present (Prag) and then From_Aspect_Specification (Prag) then
+ if Uneval_Old_Accept (Corresponding_Aspect (Prag)) then
+ Uneval_Old_Setting := 'A';
+ elsif Uneval_Old_Warn (Corresponding_Aspect (Prag)) then
+ Uneval_Old_Setting := 'W';
+ else
+ Uneval_Old_Setting := 'E';
+ end if;
+ end if;
+
+ -- Processing depends on the setting of Uneval_Old
+
+ case Uneval_Old_Setting is
when 'E' =>
Error_Attr_P
("prefix of attribute % that is potentially "
Save_Style_Check_Options (Options);
Reset_Style_Check_Options;
Opt.Warning_Mode := Suppress;
- Check_Body_For_Inlining (N, Defining_Entity (Unit_Node));
+ Check_Package_Body_For_Inlining (N, Defining_Entity (Unit_Node));
Reset_Style_Check_Options;
Set_Style_Check_Options (Options);
Set_Entity (Aspect, E);
Ent := New_Occurrence_Of (E, Sloc (Id));
+ -- Capture setting of Opt.Uneval_Old
+
+ case Opt.Uneval_Old is
+ when 'A' =>
+ Set_Uneval_Old_Accept (Aspect);
+ when 'E' =>
+ null;
+ when 'W' =>
+ Set_Uneval_Old_Warn (Aspect);
+ when others =>
+ raise Program_Error;
+ end case;
+
-- Check for duplicate aspect. Note that the Comes_From_Source
-- test allows duplicate Pre/Post's that we generate internally
-- to escape being flagged here.
return Node3 (N);
end Type_Definition;
+ function Uneval_Old_Accept
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Aspect_Specification);
+ return Flag13 (N);
+ end Uneval_Old_Accept;
+
+ function Uneval_Old_Warn
+ (N : Node_Id) return Boolean is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Aspect_Specification);
+ return Flag18 (N);
+ end Uneval_Old_Warn;
+
function Unit
(N : Node_Id) return Node_Id is
begin
Set_Elist3 (N, Val); -- semantic field, no parent set
end Set_TSS_Elist;
+ procedure Set_Uneval_Old_Accept
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Aspect_Specification);
+ Set_Flag13 (N, Val);
+ end Set_Uneval_Old_Accept;
+
+ procedure Set_Uneval_Old_Warn
+ (N : Node_Id; Val : Boolean := True) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Aspect_Specification);
+ Set_Flag18 (N, Val);
+ end Set_Uneval_Old_Warn;
+
procedure Set_Type_Definition
(N : Node_Id; Val : Node_Id) is
begin
-- if there are no type support subprograms for the type or if the freeze
-- node is not for a type.
+ -- Uneval_Old_Accept (Flag13-Sem)
+ -- Present in N_Aspect_Specification nodes. Set if Opt.Uneval_Old is set
+ -- to 'A' (accept) at the point where the aspect specification node is
+ -- encountered. It is this setting that is relevant, rather than the
+ -- setting at the point where a contract is finally analyzed after the
+ -- usual delay till the freeze point.
+
+ -- Uneval_Old_Warn (Flag18-Sem)
+ -- Present in N_Aspect_Specification nodes. Set if Opt.Uneval_Old is set
+ -- to 'W' (warn) at the point where the aspect specification node is
+ -- encountered. It is this setting that is relevant, rather than the
+ -- setting at the point where a contract is finally analyzed after the
+ -- usual delay till the freeze point. If neither Uneval_Old_Accept nor
+ -- Uneval_Old_Warn is set, then the default Error mode applies.
+
-- Unreferenced_In_Spec (Flag7-Sem)
-- Present in N_With_Clause nodes. Set if the with clause is on the
-- package or subprogram spec where the main unit is the corresponding
-- Aspect_Rep_Item (Node2-Sem)
-- Expression (Node3) Aspect_Definition (set to Empty if none)
-- Entity (Node4-Sem) entity to which the aspect applies
- -- Class_Present (Flag6) Set if 'Class present
-- Next_Rep_Item (Node5-Sem)
- -- Split_PPC (Flag17) Set if split pre/post attribute
- -- Is_Boolean_Aspect (Flag16-Sem)
+ -- Class_Present (Flag6) Set if 'Class present
+ -- Is_Ignored (Flag9-Sem)
-- Is_Checked (Flag11-Sem)
+ -- Uneval_Old_Accept (Flag13-Sem)
-- Is_Delayed_Aspect (Flag14-Sem)
-- Is_Disabled (Flag15-Sem)
- -- Is_Ignored (Flag9-Sem)
+ -- Is_Boolean_Aspect (Flag16-Sem)
+ -- Split_PPC (Flag17) Set if split pre/post attribute
+ -- Uneval_Old_Warn (Flag18-Sem)
-- Note: Aspect_Specification is an Ada 2012 feature
function Type_Definition
(N : Node_Id) return Node_Id; -- Node3
+ function Uneval_Old_Accept
+ (N : Node_Id) return Boolean; -- Flag13
+
+ function Uneval_Old_Warn
+ (N : Node_Id) return Boolean; -- Flag18
+
function Unit
(N : Node_Id) return Node_Id; -- Node2
procedure Set_Type_Definition
(N : Node_Id; Val : Node_Id); -- Node3
+ procedure Set_Uneval_Old_Accept
+ (N : Node_Id; Val : Boolean := True); -- Flag13
+
+ procedure Set_Uneval_Old_Warn
+ (N : Node_Id; Val : Boolean := True); -- Flag18
+
procedure Set_Unit
(N : Node_Id; Val : Node_Id); -- Node2
pragma Inline (Treat_Fixed_As_Integer);
pragma Inline (TSS_Elist);
pragma Inline (Type_Definition);
+ pragma Inline (Uneval_Old_Accept);
+ pragma Inline (Uneval_Old_Warn);
pragma Inline (Unit);
pragma Inline (Uninitialized_Variable);
pragma Inline (Unknown_Discriminants_Present);
pragma Inline (Set_Triggering_Alternative);
pragma Inline (Set_Triggering_Statement);
pragma Inline (Set_Type_Definition);
+ pragma Inline (Set_Uneval_Old_Accept);
+ pragma Inline (Set_Uneval_Old_Warn);
pragma Inline (Set_Unit);
pragma Inline (Set_Uninitialized_Variable);
pragma Inline (Set_Unknown_Discriminants_Present);
projects / platform / upstream / linaro-gcc.git / commitdiff