2014-01-27 Hristian Kirtchev <kirtchev@adacore.com>

	* einfo.adb (Has_Option): Reimplemented.
	* sem_prag.adb (Analyze_Refinement_Clause): Add global
	variables AR_Constit, AW_Constit, ER_Constit, EW_Constit,
	External_Constit_Seen and State. Add local variables Body_Ref,
	Body_Ref_Elmt and Extra_State. Reimplement part of the logic to
	avoid a cumbersome while pool. Verify the legality of an external
	state and relevant properties.
	(Check_External_Property): New routine.
	(Check_Matching_State): Remove parameter profile
	and update comment on usage.
	(Collect_Constituent): Store the
	relevant external property of a constituent.
	* sem_util.adb (Async_Readers_Enabled): Update the call to
	Has_Enabled_Property.
	(Async_Writers_Enabled): Update the call to Has_Enabled_Property.
	(Effective_Reads_Enabled): Update the call to Has_Enabled_Property.
	(Effective_Writes_Enabled): Update the call to Has_Enabled_Property.
	(Has_Enabled_Property): Rename formal parameter Extern to State_Id.
	Update comment on usage. Reimplement the logic to recognize the various
	formats of properties.

2014-01-27  Ed Schonberg  <schonberg@adacore.com>

	* par-ch5.adb: Minor reformatting.

2014-01-27  Tristan Gingold  <gingold@adacore.com>

	* s-tposen.ads: Harmonize style and comments.

2014-01-27  Vincent Celier  <celier@adacore.com>

	* projects.texi: Document that shared library projects, by
	default, cannot import projects that are not shared library
	projects.

2014-01-27  Robert Dewar  <dewar@adacore.com>

	* sem_ch8.adb (Find_Selected_Component): Use Replace instead
	of Rewrite.

2014-01-27  Ed Schonberg  <schonberg@adacore.com>

	* a-suenco.adb, a-suenst.adb (Decode): Raise encoding error if
	any other exception is raised.
	(Convert): If both Input_Scheme and Output_Scheme are UTF_8 it is
	still necessary to perform a conversion in order to remove overlong
	encodings.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@207142 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 63 insertions, 58 deletions

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 284872bfc53..8fc28ef4be8 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -114,11 +114,11 @@ package body Sem_Util is
    --  have a default.
 
    function Has_Enabled_Property
-     (Extern   : Node_Id;
+     (State_Id : Node_Id;
       Prop_Nam : Name_Id) return Boolean;
    --  Subsidiary to routines Async_xxx_Enabled and Effective_xxx_Enabled.
-   --  Given pragma External, determine whether it contains a property denoted
-   --  by its name Prop_Nam and if it does, whether its expression is True.
+   --  Determine whether an abstract state denoted by its entity State_Id has
+   --  enabled property Prop_Name.
 
    function Has_Null_Extension (T : Entity_Id) return Boolean;
    --  T is a derived tagged type. Check whether the type extension is null.
@@ -560,10 +560,7 @@ package body Sem_Util is
    function Async_Readers_Enabled (Id : Entity_Id) return Boolean is
    begin
       if Ekind (Id) = E_Abstract_State then
-         return
-           Has_Enabled_Property
-             (Extern   => Get_Pragma (Id, Pragma_External),
-              Prop_Nam => Name_Async_Readers);
+         return Has_Enabled_Property (Id, Name_Async_Readers);
 
       else pragma Assert (Ekind (Id) = E_Variable);
          return Present (Get_Pragma (Id, Pragma_Async_Readers));
@@ -577,10 +574,7 @@ package body Sem_Util is
    function Async_Writers_Enabled (Id : Entity_Id) return Boolean is
    begin
       if Ekind (Id) = E_Abstract_State then
-         return
-           Has_Enabled_Property
-             (Extern   => Get_Pragma (Id, Pragma_External),
-              Prop_Nam => Name_Async_Writers);
+         return Has_Enabled_Property (Id, Name_Async_Writers);
 
       else pragma Assert (Ekind (Id) = E_Variable);
          return Present (Get_Pragma (Id, Pragma_Async_Writers));
@@ -4818,10 +4812,7 @@ package body Sem_Util is
    function Effective_Reads_Enabled (Id : Entity_Id) return Boolean is
    begin
       if Ekind (Id) = E_Abstract_State then
-         return
-           Has_Enabled_Property
-             (Extern   => Get_Pragma (Id, Pragma_External),
-              Prop_Nam => Name_Effective_Reads);
+         return Has_Enabled_Property (Id, Name_Effective_Reads);
 
       else pragma Assert (Ekind (Id) = E_Variable);
          return Present (Get_Pragma (Id, Pragma_Effective_Reads));
@@ -4835,10 +4826,7 @@ package body Sem_Util is
    function Effective_Writes_Enabled (Id : Entity_Id) return Boolean is
    begin
       if Ekind (Id) = E_Abstract_State then
-         return
-           Has_Enabled_Property
-             (Extern   => Get_Pragma (Id, Pragma_External),
-              Prop_Nam => Name_Effective_Writes);
+         return Has_Enabled_Property (Id, Name_Effective_Writes);
 
       else pragma Assert (Ekind (Id) = E_Variable);
          return Present (Get_Pragma (Id, Pragma_Effective_Writes));
@@ -7182,69 +7170,86 @@ package body Sem_Util is
    --------------------------
 
    function Has_Enabled_Property
-     (Extern   : Node_Id;
+     (State_Id : Node_Id;
       Prop_Nam : Name_Id) return Boolean
    is
-      Prop  : Node_Id;
-      Props : Node_Id := Empty;
+      Decl    : constant Node_Id := Parent (State_Id);
+      Opt     : Node_Id;
+      Opt_Nam : Node_Id;
+      Prop    : Node_Id;
+      Props   : Node_Id;
 
    begin
-      --  The related abstract state or variable do not have an Extern pragma,
-      --  the property in question cannot be set.
+      --  The declaration of an external abstract state appears as an extension
+      --  aggregate. If this is not the case, properties can never be set.
 
-      if No (Extern) then
+      if Nkind (Decl) /= N_Extension_Aggregate then
          return False;
-
-      elsif Nkind (Extern) = N_Component_Association then
-         Props := Expression (Extern);
       end if;
 
-      --  External state with properties
+      --  When External appears as a simple option, it automatically enables
+      --  all properties.
 
-      if Present (Props) then
+      Opt := First (Expressions (Decl));
+      while Present (Opt) loop
+         if Nkind (Opt) = N_Identifier
+           and then Chars (Opt) = Name_External
+         then
+            return True;
+         end if;
 
-         --  Multiple properties appear as an aggregate
+         Next (Opt);
+      end loop;
 
-         if Nkind (Props) = N_Aggregate then
+      --  When External specifies particular properties, inspect those and
+      --  find the desired one (if any).
 
-            --  Simple property form
+      Opt := First (Component_Associations (Decl));
+      while Present (Opt) loop
+         Opt_Nam := First (Choices (Opt));
 
-            Prop := First (Expressions (Props));
-            while Present (Prop) loop
-               if Chars (Prop) = Prop_Nam then
-                  return True;
-               end if;
+         if Nkind (Opt_Nam) = N_Identifier
+           and then Chars (Opt_Nam) = Name_External
+         then
+            Props := Expression (Opt);
 
-               Next (Prop);
-            end loop;
+            --  Multiple properties appear as an aggregate
 
-            --  Property with expression form
+            if Nkind (Props) = N_Aggregate then
 
-            Prop := First (Component_Associations (Props));
-            while Present (Prop) loop
-               if Chars (Prop) = Prop_Nam then
-                  return Is_True (Expr_Value (Expression (Prop)));
-               end if;
+               --  Simple property form
 
-               Next (Prop);
-            end loop;
+               Prop := First (Expressions (Props));
+               while Present (Prop) loop
+                  if Chars (Prop) = Prop_Nam then
+                     return True;
+                  end if;
+
+                  Next (Prop);
+               end loop;
 
-            --  Pragma Extern contains properties, but not the one we want
+               --  Property with expression form
 
-            return False;
+               Prop := First (Component_Associations (Props));
+               while Present (Prop) loop
+                  if Chars (Prop) = Prop_Nam then
+                     return Is_True (Expr_Value (Expression (Prop)));
+                  end if;
+
+                  Next (Prop);
+               end loop;
 
-         --  Single property
+            --  Single property
 
-         else
-            return Chars (Prop) = Prop_Nam;
+            else
+               return Chars (Prop) = Prop_Nam;
+            end if;
          end if;
 
-      --  An external state defined without any properties defaults all
-      --  properties to True;
+         Next (Opt);
+      end loop;
 
-      else
-         return True;
-      end if;
+      return False;
    end Has_Enabled_Property;
 
    --------------------