[multiple changes]

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.

From-SVN: r207142

gcc/ada/ChangeLog

+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.
+
 2014-01-27  Robert Dewar  <dewar@adacore.com>
 
 	* exp_smem.adb: Minor reformatting.

gcc/ada/a-suenco.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2010-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2010-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- --
@@ -41,9 +41,12 @@ package body Ada.Strings.UTF_Encoding.Conversions is
       Output_BOM    : Boolean := False) return UTF_String
    is
    begin
-      --  Nothing to do if identical schemes
+      --  Nothing to do if identical schemes, but for UTF_8 we need to
+      --  exclude overlong encodings, so need to do the full conversion.
 
-      if Input_Scheme = Output_Scheme then
+      if Input_Scheme = Output_Scheme
+        and then Input_Scheme /= UTF_8
+      then
          return Item;
 
       --  For remaining cases, one or other of the operands is UTF-16BE/LE

gcc/ada/a-suenst.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---             Copyright (C) 2010-2012, Free Software Foundation, Inc.      --
+--          Copyright (C) 2010-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- --
@@ -158,6 +158,12 @@ package body Ada.Strings.UTF_Encoding.Strings is
       end loop;
 
       return Result (1 .. Len);
+
+   exception
+      --  'Val may have been out of range
+
+      when others =>
+         Raise_Encoding_Error (Iptr - 1);
    end Decode;
 
    --  Decode UTF-16 input to String

gcc/ada/einfo.adb

@@ -589,10 +589,10 @@ package body Einfo is
    -----------------------
 
    function Has_Option
-     (State   : Entity_Id;
-      Opt_Nam : Name_Id) return Boolean;
-   --  Determine whether abstract state State has a particular option denoted
-   --  by the name Opt_Nam.
+     (State_Id   : Entity_Id;
+      Option_Nam : Name_Id) return Boolean;
+   --  Determine whether abstract state State_Id has particular option denoted
+   --  by the name Option_Nam.
 
    ---------------
    -- Float_Rep --
@@ -609,32 +609,55 @@ package body Einfo is
    ----------------
 
    function Has_Option
-     (State   : Entity_Id;
-      Opt_Nam : Name_Id) return Boolean
+     (State_Id   : Entity_Id;
+      Option_Nam : Name_Id) return Boolean
    is
-      Par : constant Node_Id := Parent (State);
-      Opt : Node_Id;
+      Decl    : constant Node_Id := Parent (State_Id);
+      Opt     : Node_Id;
+      Opt_Nam : Node_Id;
 
    begin
-      pragma Assert (Ekind (State) = E_Abstract_State);
+      pragma Assert (Ekind (State_Id) = E_Abstract_State);
 
-      --  States with options appear as extension aggregates in the tree
+      --  The declaration of abstract states with options appear as an
+      --  extension aggregate. If this is not the case, the option is not
+      --  available.
 
-      if Nkind (Par) = N_Extension_Aggregate then
-         if Opt_Nam = Name_Part_Of then
-            return Present (Component_Associations (Par));
+      if Nkind (Decl) /= N_Extension_Aggregate then
+         return False;
+      end if;
 
-         else
-            Opt := First (Expressions (Par));
-            while Present (Opt) loop
-               if Chars (Opt) = Opt_Nam then
-                  return True;
-               end if;
+      --  Simple options
 
-               Next (Opt);
-            end loop;
+      Opt := First (Expressions (Decl));
+      while Present (Opt) loop
+
+         --  Currently the only simple option allowed is External
+
+         if Nkind (Opt) = N_Identifier
+           and then Chars (Opt) = Name_External
+           and then Chars (Opt) = Option_Nam
+         then
+            return True;
          end if;
-      end if;
+
+         Next (Opt);
+      end loop;
+
+      --  Complex options with various specifiers
+
+      Opt := First (Component_Associations (Decl));
+      while Present (Opt) loop
+         Opt_Nam := First (Choices (Opt));
+
+         if Nkind (Opt_Nam) = N_Identifier
+           and then Chars (Opt_Nam) = Option_Nam
+         then
+            return True;
+         end if;
+
+         Next (Opt);
+      end loop;
 
       return False;
    end Has_Option;

gcc/ada/par-ch5.adb

@@ -1739,14 +1739,13 @@ package body Ch5 is
       elsif Prev_Token = Tok_In
         and then Present (Subtype_Indication (Node1))
       then
-
          --  Simplest recovery is to transform it into an element iterator.
          --  Error message on 'in" has already been emitted when parsing the
          --  optional constraint.
 
          Set_Of_Present (Node1);
          Error_Msg_N
-           ("subtype indication is only legal on on element iterator",
+           ("subtype indication is only legal on an element iterator",
               Subtype_Indication (Node1));
 
       else

gcc/ada/projects.texi

@@ -1616,6 +1616,10 @@ implementation part of the library implies minimal post-compilation actions on
 the complete system and potentially no action at all for the rest of the
 system in the case of dynamic SALs.
 
+There is a restriction on shared library projects: by default, they are only
+allowed to import other shared library projects. They are not allowed to
+import non library projects or static library projects.
+
 The GNAT Project Manager takes complete care of the library build, rebuild and
 installation tasks, including recompilation of the source files for which
 objects do not exist or are not up to date, assembly of the library archive, and

gcc/ada/s-tposen.ads

 ------------------------------------------------------------------------------
 --                                                                          --
---                GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                  --
+--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
 --                                                                          --
---             SYSTEM.TASKING.PROTECTED_OBJECTS.SINGLE_ENTRY                --
+--               SYSTEM.TASKING.PROTECTED_OBJECTS.SINGLE_ENTRY              --
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, Free Software Foundation, Inc.         --
 --                                                                          --
--- GNARL 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- --
 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
@@ -31,7 +31,7 @@
 
 --  This package provides an optimized version of Protected_Objects.Operations
 --  and Protected_Objects.Entries making the following assumptions:
---
+
 --    PO have only one entry
 --    There is only one caller at a time (No_Entry_Queue)
 --    There is no dynamic priority support (No_Dynamic_Priorities)
@@ -39,17 +39,17 @@
 --      (No_Abort_Statements, Max_Asynchronous_Select_Nesting => 0)
 --    PO are at library level
 --    None of the tasks will terminate (no need for finalization)
---
---  This interface is intended to be used in the ravenscar profile, the
+
+--  This interface is intended to be used in the Ravenscar profile, the
 --  compiler is responsible for ensuring that the conditions mentioned above
 --  are respected, except for the No_Entry_Queue restriction that is checked
 --  dynamically in this package, since the check cannot be performed at compile
 --  time, and is relatively cheap (see body).
---
+
 --  This package is part of the high level tasking interface used by the
 --  compiler to expand Ada 95 tasking constructs into simpler run time calls
 --  (aka GNARLI, GNU Ada Run-time Library Interface)
---
+
 --  Note: the compiler generates direct calls to this interface, via Rtsfind.
 --  Any changes to this interface may require corresponding compiler changes
 --  in exp_ch9.adb and possibly exp_ch7.adb
@@ -191,34 +191,34 @@ package System.Tasking.Protected_Objects.Single_Entry is
    --  to keep track of the runtime state of a protected object.
 
    procedure Lock_Entry (Object : Protection_Entry_Access);
-   --  Lock a protected object for write access. Upon return, the caller
-   --  owns the lock to this object, and no other call to Lock or
-   --  Lock_Read_Only with the same argument will return until the
-   --  corresponding call to Unlock has been made by the caller.
+   --  Lock a protected object for write access. Upon return, the caller owns
+   --  the lock to this object, and no other call to Lock or Lock_Read_Only
+   --  with the same argument will return until the corresponding call to
+   --  Unlock has been made by the caller.
 
    procedure Lock_Read_Only_Entry
      (Object : Protection_Entry_Access);
-   --  Lock a protected object for read access.  Upon return, the caller
-   --  owns the lock for read access, and no other calls to Lock
-   --  with the same argument will return until the corresponding call
-   --  to Unlock has been made by the caller.  Other calls to Lock_Read_Only
-   --  may (but need not) return before the call to Unlock, and the
-   --  corresponding callers will also own the lock for read access.
+   --  Lock a protected object for read access. Upon return, the caller owns
+   --  the lock for read access, and no other calls to Lock with the same
+   --  argument will return until the corresponding call to Unlock has been
+   --  made by the caller. Other calls to Lock_Read_Only may (but need not)
+   --  return before the call to Unlock, and the corresponding callers will
+   --  also own the lock for read access.
 
    procedure Unlock_Entry (Object : Protection_Entry_Access);
-   --  Relinquish ownership of the lock for the object represented by
-   --  the Object parameter.  If this ownership was for write access, or
-   --  if it was for read access where there are no other read access
-   --  locks outstanding, one (or more, in the case of Lock_Read_Only)
-   --  of the tasks waiting on this lock (if any) will be given the
-   --  lock and allowed to return from the Lock or Lock_Read_Only call.
+   --  Relinquish ownership of the lock for the object represented by the
+   --  Object parameter. If this ownership was for write access, or if it was
+   --  for read access where there are no other read access locks outstanding,
+   --  one (or more, in the case of Lock_Read_Only) of the tasks waiting on
+   --  this lock (if any) will be given the lock and allowed to return from
+   --  the Lock or Lock_Read_Only call.
 
    procedure Service_Entry (Object : Protection_Entry_Access);
    --  Service the entry queue of the specified object, executing the
    --  corresponding body of any queued entry call that is waiting on True
    --  barrier. This is used when the state of a protected object may have
-   --  changed, in particular after the execution of the statement sequence of
-   --  a protected procedure.
+   --  changed, in particular after the execution of the statement sequence
+   --  of a protected procedure.
    --
    --  This must be called with abort deferred and with the corresponding
    --  object locked. Object is unlocked on return.
@@ -227,9 +227,10 @@ package System.Tasking.Protected_Objects.Single_Entry is
      (Object              : Protection_Entry_Access;
       Uninterpreted_Data  : System.Address;
       Mode                : Call_Modes);
-   --  Make a protected entry call to the specified object.
-   --  Pend a protected entry call on the protected object represented
-   --  by Object. A pended call is not queued; it may be executed immediately
+   --  Make a protected entry call to the specified object
+   --
+   --  Pend a protected entry call on the protected object represented by
+   --  Object. A pended call is not queued; it may be executed immediately
    --  or queued, depending on the state of the entry barrier.
    --
    --    Uninterpreted_Data
@@ -258,19 +259,18 @@ package System.Tasking.Protected_Objects.Single_Entry is
    procedure Exceptional_Complete_Single_Entry_Body
      (Object : Protection_Entry_Access;
       Ex     : Ada.Exceptions.Exception_Id);
-   --  Perform all of the functions of Complete_Entry_Body. In addition,
-   --  report in Ex the exception whose propagation terminated the entry
-   --  body to the runtime system.
+   --  Perform all of the functions of Complete_Entry_Body. In addition, report
+   --  in Ex the exception whose propagation terminated the entry body to the
+   --  runtime system.
 
-   function Protected_Count_Entry (Object : Protection_Entry)
-     return Natural;
+   function Protected_Count_Entry (Object : Protection_Entry) return Natural;
    --  Return the number of entry calls on Object (0 or 1)
 
-   function Protected_Single_Entry_Caller (Object : Protection_Entry)
-     return Task_Id;
-   --  Return value of E'Caller, where E is the protected entry currently
-   --  being handled. This will only work if called from within an
-   --  entry body, as required by the LRM (C.7.1(14)).
+   function Protected_Single_Entry_Caller
+     (Object : Protection_Entry) return Task_Id;
+   --  Return value of E'Caller, where E is the protected entry currently being
+   --  handled. This will only work if called from within an entry body, as
+   --  required by the LRM (C.7.1(14)).
 
 private
    type Protection_Entry is record

gcc/ada/sem_ch8.adb

@@ -6296,8 +6296,9 @@ package body Sem_Ch8 is
                --  If no interpretation as an expanded name is possible, it
                --  must be a selected component of a record returned by a
                --  function call. Reformat prefix as a function call, the rest
-               --  is done by type resolution. If the prefix is procedure or
-               --  entry, as is P.X; this is an error.
+               --  is done by type resolution.
+
+               --  Error if the prefix is procedure or entry, as is P.X
 
                if Ekind (P_Name) /= E_Function
                  and then
@@ -6309,7 +6310,6 @@ package body Sem_Ch8 is
                   --  chain, the candidate package may be anywhere on it.
 
                   if Present (Homonym (Current_Entity (P_Name))) then
-
                      P_Name := Current_Entity (P_Name);
 
                      while Present (P_Name) loop
@@ -6327,6 +6327,7 @@ package body Sem_Ch8 is
                         Set_Entity (Prefix (N), P_Name);
                         Find_Expanded_Name (N);
                         return;
+
                      else
                         P_Name := Entity (Prefix (N));
                      end if;
@@ -6338,11 +6339,27 @@ package body Sem_Ch8 is
                   Set_Entity (N, Any_Id);
                   Set_Etype (N, Any_Type);
 
+               --  Here we have a function call, so do the reformatting
+
                else
                   Nam := New_Copy (P);
                   Save_Interps (P, Nam);
-                  Rewrite (P,
+
+                  --  We use Replace here because this is one of those cases
+                  --  where the parser has missclassified the node, and we
+                  --  fix things up and then do the semantic analysis on the
+                  --  fixed up node. Normally we do this using one of the
+                  --  Sinfo.CN routines, but this is too tricky for that.
+
+                  --  Note that using Rewrite would be wrong, because we
+                  --  would have a tree where the original node is unanalyzed,
+                  --  and this violates the required interface for ASIS.
+
+                  Replace (P,
                     Make_Function_Call (Sloc (P), Name => Nam));
+
+                  --  Now analyze the reformatted node
+
                   Analyze_Call (P);
                   Analyze_Selected_Component (N);
                end if;

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;
 
    --------------------