Commit bf561f2b by Arnaud Charlet

[multiple changes]

2014-07-17  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb (Buid_Protected_Subprogram_Call): Preserve type
	of function call for later use when shared passive objects
	are involved.

2014-07-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* par-ch13.adb (Get_Aspect_Specifications):
	Catch a case where the argument of SPARK aspect Refined_State
	is not properly parenthesized.

2014-07-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch6.adb (Expand_Ctrl_Function_Call): Do not extend
	the lifetime of a reference to an Ada 2012 container element.
	(Is_Element_Reference): New routine.

2014-07-17  Robert Dewar  <dewar@adacore.com>

	* ali.ads: Minor comment fix.
	* lib-writ.adb: Minor reformatting.

2014-07-17  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Analyze_Proper_Body): When analyzing a subunit
	in ASIS mode, load another subunit only if it a subunit of the
	current one, not a sibling that has been reached through the
	analysis of an ancestor. This allows the construction of the
	ASIS tree for the subunit even when sibling subunits have errors.

2014-07-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch3.adb (Analyze_Declarations): Remove the guard which
	prevents the analysis of various contracts when the associated
	construct is erroneous.
	* sem_util.adb (Save_SPARK_Mode_And_Set): Do not query the
	SPARK_Pragma of an illegal or a partially decorated construct.

From-SVN: r212734
parent 8a5e4b2a
2014-07-17 Ed Schonberg <schonberg@adacore.com>
* exp_ch9.adb (Buid_Protected_Subprogram_Call): Preserve type
of function call for later use when shared passive objects
are involved.
2014-07-17 Hristian Kirtchev <kirtchev@adacore.com>
* par-ch13.adb (Get_Aspect_Specifications):
Catch a case where the argument of SPARK aspect Refined_State
is not properly parenthesized.
2014-07-17 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch6.adb (Expand_Ctrl_Function_Call): Do not extend
the lifetime of a reference to an Ada 2012 container element.
(Is_Element_Reference): New routine.
2014-07-17 Robert Dewar <dewar@adacore.com>
* ali.ads: Minor comment fix.
* lib-writ.adb: Minor reformatting.
2014-07-17 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Analyze_Proper_Body): When analyzing a subunit
in ASIS mode, load another subunit only if it a subunit of the
current one, not a sibling that has been reached through the
analysis of an ancestor. This allows the construction of the
ASIS tree for the subunit even when sibling subunits have errors.
2014-07-17 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb (Analyze_Declarations): Remove the guard which
prevents the analysis of various contracts when the associated
construct is erroneous.
* sem_util.adb (Save_SPARK_Mode_And_Set): Do not query the
SPARK_Pragma of an illegal or a partially decorated construct.
2014-07-17 Robert Dewar <dewar@adacore.com> 2014-07-17 Robert Dewar <dewar@adacore.com>
* s-imguns.ads: Minor reformatting. * s-imguns.ads: Minor reformatting.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -289,7 +289,7 @@ package ALI is ...@@ -289,7 +289,7 @@ package ALI is
Set_Elab_Entity : Boolean; Set_Elab_Entity : Boolean;
-- Indicates presence of EE parameter for a unit which has an -- Indicates presence of EE parameter for a unit which has an
-- elaboration entity which must be set true as part of the -- elaboration entity which must be set true as part of the
-- elaboration of the entity. -- elaboration of the unit.
Has_RACW : Boolean; Has_RACW : Boolean;
-- Indicates presence of RA parameter for a package that declares at -- Indicates presence of RA parameter for a package that declares at
......
...@@ -4195,6 +4195,33 @@ package body Exp_Ch6 is ...@@ -4195,6 +4195,33 @@ package body Exp_Ch6 is
------------------------------- -------------------------------
procedure Expand_Ctrl_Function_Call (N : Node_Id) is procedure Expand_Ctrl_Function_Call (N : Node_Id) is
function Is_Element_Reference (N : Node_Id) return Boolean;
-- Determine whether node N denotes a reference to an Ada 2012 container
-- element.
--------------------------
-- Is_Element_Reference --
--------------------------
function Is_Element_Reference (N : Node_Id) return Boolean is
Ref : constant Node_Id := Original_Node (N);
begin
-- Analysis marks an element reference by setting the generalized
-- indexing attribute of an indexed component before the component
-- is rewritten into a function call.
return
Nkind (Ref) = N_Indexed_Component
and then Present (Generalized_Indexing (Ref));
end Is_Element_Reference;
-- Local variables
Is_Elem_Ref : constant Boolean := Is_Element_Reference (N);
-- Start of processing for Expand_Ctrl_Function_Call
begin begin
-- Optimization, if the returned value (which is on the sec-stack) is -- Optimization, if the returned value (which is on the sec-stack) is
-- returned again, no need to copy/readjust/finalize, we can just pass -- returned again, no need to copy/readjust/finalize, we can just pass
...@@ -4216,12 +4243,17 @@ package body Exp_Ch6 is ...@@ -4216,12 +4243,17 @@ package body Exp_Ch6 is
Remove_Side_Effects (N); Remove_Side_Effects (N);
-- When the temporary function result appears inside a case or an if -- When the temporary function result appears inside a case expression
-- expression, its lifetime must be extended to match that of the -- or an if expression, its lifetime must be extended to match that of
-- context. If not, the function result would be finalized prematurely -- the context. If not, the function result will be finalized too early
-- and the evaluation of the expression could yield the wrong result. -- and the evaluation of the expression could yield incorrect result. An
-- exception to this rule are references to Ada 2012 container elements.
if Within_Case_Or_If_Expression (N) -- Such references must be finalized at the end of each iteration of the
-- related quantified expression, otherwise the container will remain
-- busy.
if not Is_Elem_Ref
and then Within_Case_Or_If_Expression (N)
and then Nkind (N) = N_Explicit_Dereference and then Nkind (N) = N_Explicit_Dereference
then then
Set_Is_Processed_Transient (Entity (Prefix (N))); Set_Is_Processed_Transient (Entity (Prefix (N)));
......
...@@ -4379,6 +4379,12 @@ package body Exp_Ch9 is ...@@ -4379,6 +4379,12 @@ package body Exp_Ch9 is
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => New_Sub, Name => New_Sub,
Parameter_Associations => Params)); Parameter_Associations => Params));
-- Preserve type of call for subsequent processing (required for
-- call to Wrap_Transient_Expression in the case of a shared passive
-- protected).
Set_Etype (N, Etype (New_Sub));
end if; end if;
if External if External
......
...@@ -428,10 +428,8 @@ package body Lib.Writ is ...@@ -428,10 +428,8 @@ package body Lib.Writ is
-- If this is a spec ... -- If this is a spec ...
if (Is_Subprogram (Uent) if (Is_Subprogram (Uent)
or else or else Ekind (Uent) = E_Package
Ekind (Uent) = E_Package or else Is_Generic_Unit (Uent))
or else
Is_Generic_Unit (Uent))
-- and an elaboration entity was declared ... -- and an elaboration entity was declared ...
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -308,8 +308,8 @@ package body Ch13 is ...@@ -308,8 +308,8 @@ package body Ch13 is
end if; end if;
-- Detect a common error where the non-null definition of -- Detect a common error where the non-null definition of
-- aspect Depends, Global, Refined_Depends or Refined_Global -- aspect Depends, Global, Refined_Depends, Refined_Global
-- must be enclosed in parentheses. -- or Refined_State lacks enclosing parentheses.
if Token /= Tok_Left_Paren and then Token /= Tok_Null then if Token /= Tok_Left_Paren and then Token /= Tok_Null then
...@@ -400,6 +400,48 @@ package body Ch13 is ...@@ -400,6 +400,48 @@ package body Ch13 is
Restore_Scan_State (Scan_State); Restore_Scan_State (Scan_State);
end if; end if;
end; end;
-- Refined_State
elsif A_Id = Aspect_Refined_State then
if Token = Tok_Identifier then
declare
Scan_State : Saved_Scan_State;
begin
Save_Scan_State (Scan_State);
Scan; -- past state
-- The refinement contains a constituent, the whole
-- argument of Refined_State must be parenthesized.
-- with Refined_State => State => Constit
if Token = Tok_Arrow then
Restore_Scan_State (Scan_State);
Error_Msg_SC -- CODEFIX
("missing ""(""");
Resync_Past_Malformed_Aspect;
-- Return when the current aspect is the last
-- in the list of specifications and the list
-- applies to a body.
if Token = Tok_Is then
return Aspects;
end if;
-- The refinement lacks constituents. Do not flag
-- this case as the error would be misleading. The
-- diagnostic is left to the analysis.
-- with Refined_State => State
else
Restore_Scan_State (Scan_State);
end if;
end;
end if;
end if; end if;
end if; end if;
......
...@@ -1703,12 +1703,16 @@ package body Sem_Ch10 is ...@@ -1703,12 +1703,16 @@ package body Sem_Ch10 is
-- If the main unit is a subunit, then we are just performing semantic -- If the main unit is a subunit, then we are just performing semantic
-- analysis on that subunit, and any other subunits of any parent unit -- analysis on that subunit, and any other subunits of any parent unit
-- should be ignored, except that if we are building trees for ASIS -- should be ignored, except that if we are building trees for ASIS
-- usage we want to annotate the stub properly. -- usage we want to annotate the stub properly. If the main unit is
-- itself a subunit, another subunit is irrelevant unless it is a
-- subunit of the current one.
elsif Nkind (Unit (Cunit (Main_Unit))) = N_Subunit elsif Nkind (Unit (Cunit (Main_Unit))) = N_Subunit
and then Subunit_Name /= Unit_Name (Main_Unit) and then Subunit_Name /= Unit_Name (Main_Unit)
then then
if ASIS_Mode then if ASIS_Mode
and then Scope (Defining_Entity (N)) = Cunit_Entity (Main_Unit)
then
Optional_Subunit; Optional_Subunit;
end if; end if;
......
...@@ -2366,14 +2366,11 @@ package body Sem_Ch3 is ...@@ -2366,14 +2366,11 @@ package body Sem_Ch3 is
-- Analyze the contracts of subprogram declarations, subprogram bodies -- Analyze the contracts of subprogram declarations, subprogram bodies
-- and variables now due to the delayed visibility requirements of their -- and variables now due to the delayed visibility requirements of their
-- aspects. Skip analysis if the declaration already has an error. -- aspects.
Decl := First (L); Decl := First (L);
while Present (Decl) loop while Present (Decl) loop
if Error_Posted (Decl) then if Nkind (Decl) = N_Object_Declaration then
null;
elsif Nkind (Decl) = N_Object_Declaration then
Analyze_Object_Contract (Defining_Entity (Decl)); Analyze_Object_Contract (Defining_Entity (Decl));
elsif Nkind_In (Decl, N_Abstract_Subprogram_Declaration, elsif Nkind_In (Decl, N_Abstract_Subprogram_Declaration,
......
...@@ -15672,17 +15672,18 @@ package body Sem_Util is ...@@ -15672,17 +15672,18 @@ package body Sem_Util is
(Context : Entity_Id; (Context : Entity_Id;
Mode : out SPARK_Mode_Type) Mode : out SPARK_Mode_Type)
is is
Prag : constant Node_Id := SPARK_Pragma (Context);
begin begin
-- Save the current mode in effect -- Save the current mode in effect
Mode := SPARK_Mode; Mode := SPARK_Mode;
-- Set the mode of the context as the current SPARK mode -- Do not consider illegal or partially decorated constructs
if Ekind (Context) = E_Void or else Error_Posted (Context) then
null;
if Present (Prag) then elsif Present (SPARK_Pragma (Context)) then
SPARK_Mode := Get_SPARK_Mode_From_Pragma (Prag); SPARK_Mode := Get_SPARK_Mode_From_Pragma (SPARK_Pragma (Context));
end if; end if;
end Save_SPARK_Mode_And_Set; end Save_SPARK_Mode_And_Set;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment