OSDN Git Service

2011-11-04 Gary Dismukes <dismukes@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 4 Nov 2011 13:55:34 +0000 (13:55 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 4 Nov 2011 13:55:34 +0000 (13:55 +0000)
* bindgen.adb (Gen_Elab_Calls): In the case
of the AAMP target, set elaboration entities to 1 rather than
incrementing.

2011-11-04  Ed Schonberg  <schonberg@adacore.com>

* sem_ch10.adb (Install_Limited_With_Unit): To establish the
proper entities on the ancestors of a child unit that appear
in a limited_with clause, follow the unit links because the
units are not analyzed and scope information is incomplete.

2011-11-04  Eric Botcazou  <ebotcazou@adacore.com>

* exp_ch4.adb (Expand_N_Selected_Component): Refine code
setting the Atomic_Sync_Required flag to detect one more case.
* exp_util.adb (Activate_Atomic_Synchronization): Refine code
setting the Atomic_Sync_Required flag to exclude more cases,
depending on the parent of the node to be examined.

2011-11-04  Bob Duff  <duff@adacore.com>

* g-excact.adb: Minor: use named notation.

2011-11-04  Ed Schonberg  <schonberg@adacore.com>

* sem_ch5.adb: Improve error messages for illegal iterators.

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

gcc/ada/ChangeLog
gcc/ada/bindgen.adb
gcc/ada/exp_ch4.adb
gcc/ada/exp_util.adb
gcc/ada/g-excact.adb
gcc/ada/sem_ch10.adb
gcc/ada/sem_ch5.adb

index 392c0b1..41bd2b6 100644 (file)
@@ -1,3 +1,32 @@
+2011-11-04  Gary Dismukes  <dismukes@adacore.com>
+
+       * bindgen.adb (Gen_Elab_Calls): In the case
+       of the AAMP target, set elaboration entities to 1 rather than
+       incrementing.
+
+2011-11-04  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch10.adb (Install_Limited_With_Unit): To establish the
+       proper entities on the ancestors of a child unit that appear
+       in a limited_with clause, follow the unit links because the
+       units are not analyzed and scope information is incomplete.
+
+2011-11-04  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * exp_ch4.adb (Expand_N_Selected_Component): Refine code
+       setting the Atomic_Sync_Required flag to detect one more case.
+       * exp_util.adb (Activate_Atomic_Synchronization): Refine code
+       setting the Atomic_Sync_Required flag to exclude more cases,
+       depending on the parent of the node to be examined.
+
+2011-11-04  Bob Duff  <duff@adacore.com>
+
+       * g-excact.adb: Minor: use named notation.
+
+2011-11-04  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch5.adb: Improve error messages for illegal iterators.
+
 2011-11-04  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * exp_alfa.adb: Add with and use clauses for Exp_Ch8 and
index e99d875..a4b7d39 100644 (file)
@@ -1060,18 +1060,31 @@ package body Bindgen is
                then
                   Set_String ("      E");
                   Set_Unit_Number (Unum_Spec);
-                  Set_String (" := E");
-                  Set_Unit_Number (Unum_Spec);
-                  Set_String (" + 1;");
+
+                  --  The AAMP target has no notion of shared libraries, and
+                  --  there's no possibility of reelaboration, so we treat the
+                  --  the elaboration var as a flag instead of a counter and
+                  --  simply set it.
+
+                  if AAMP_On_Target then
+                     Set_String (" := 1;");
+
+                  --  Otherwise (normal case), increment elaboration counter
+
+                  else
+                     Set_String (" := E");
+                     Set_Unit_Number (Unum_Spec);
+                     Set_String (" + 1;");
+                  end if;
+
                   Write_Statement_Buffer;
 
                --  In the special case where the target is AAMP and the unit is
                --  a spec with a body, the elaboration entity is initialized
                --  here. This is done because it's the only way to accomplish
-               --  initialization of such entities, because there's not any
-               --  mechanism provided to initialize global variables at load
-               --  time on AAMP. (Also note that there is no notion of shared
-               --  libraries for AAMP, so no possibility of reelaboration.)
+               --  initialization of such entities, as there is no mechanism
+               --  provided for initializing global variables at load time on
+               --  AAMP.
 
                elsif AAMP_On_Target
                  and then U.Utype = Is_Spec
@@ -1106,10 +1119,9 @@ package body Bindgen is
                --  In the special case where the target is AAMP and the unit is
                --  a spec with a body, the elaboration entity is initialized
                --  here. This is done because it's the only way to accomplish
-               --  initialization of such entities, because there's not any
-               --  mechanism provided to initialize global variables at load
-               --  time on AAMP. (Also note that there is no notion of shared
-               --  libraries for AAMP, so no possibility of reelaboration.)
+               --  initialization of such entities, as there is no mechanism
+               --  provided for initializing global variables at load time on
+               --  AAMP.
 
                if AAMP_On_Target
                  and then U.Utype = Is_Spec
@@ -1185,9 +1197,23 @@ package body Bindgen is
                then
                   Set_String ("      E");
                   Set_Unit_Number (Unum_Spec);
-                  Set_String (" := E");
-                  Set_Unit_Number (Unum_Spec);
-                  Set_String (" + 1;");
+
+                  --  The AAMP target has no notion of shared libraries, and
+                  --  there's no possibility of reelaboration, so we treat the
+                  --  the elaboration var as a flag instead of a counter and
+                  --  simply set it.
+
+                  if AAMP_On_Target then
+                     Set_String (" := 1;");
+
+                  --  Otherwise (normal case), increment elaboration counter
+
+                  else
+                     Set_String (" := E");
+                     Set_Unit_Number (Unum_Spec);
+                     Set_String (" + 1;");
+                  end if;
+
                   Write_Statement_Buffer;
                end if;
             end if;
index b056d11..8f2b865 100644 (file)
@@ -8196,15 +8196,44 @@ package body Exp_Ch4 is
          Analyze (N);
       end if;
 
-      --  If we still have a selected component, and the type is an Atomic
-      --  type for which Atomic_Sync is enabled, then we set the atomic sync
-      --  flag on the selector.
+      --  Set Atomic_Sync_Required if necessary for atomic component
 
-      if Nkind (N) = N_Selected_Component
-        and then Is_Atomic (Etype (N))
-        and then not Atomic_Synchronization_Disabled (Etype (N))
-      then
-         Activate_Atomic_Synchronization (N);
+      if Nkind (N) = N_Selected_Component then
+         declare
+            E   : constant Entity_Id := Entity (Selector_Name (N));
+            Set : Boolean;
+
+         begin
+            --  If component is atomic, but type is not, setting depends on
+            --  disable/enable state for the component.
+
+            if Is_Atomic (E) and then not Is_Atomic (Etype (E)) then
+               Set := not Atomic_Synchronization_Disabled (E);
+
+            --  If component is not atomic, but its type is atomic, setting
+            --  depends on disable/enable state for the type.
+
+            elsif not Is_Atomic (E) and then Is_Atomic (Etype (E)) then
+               Set := not Atomic_Synchronization_Disabled (Etype (E));
+
+            --  If both component and type are atomic, we disable if either
+            --  component or its type have sync disabled.
+
+            elsif Is_Atomic (E) and then Is_Atomic (Etype (E)) then
+               Set := (not Atomic_Synchronization_Disabled (E))
+                        and then
+                      (not Atomic_Synchronization_Disabled (Etype (E)));
+
+            else
+               Set := False;
+            end if;
+
+            --  Set flag if required
+
+            if Set then
+               Activate_Atomic_Synchronization (N);
+            end if;
+         end;
       end if;
    end Expand_N_Selected_Component;
 
index 8281ded..aa33066 100644 (file)
@@ -168,14 +168,30 @@ package body Exp_Util is
       Msg_Node : Node_Id;
 
    begin
-      --  Nothing to do if we are the prefix of an attribute, since we do not
-      --  want an atomic sync operation for things like A'Adress or A'Size).
 
-      if Nkind (Parent (N)) = N_Attribute_Reference
-        and then Prefix (Parent (N)) = N
-      then
-         return;
-      end if;
+      case Nkind (Parent (N)) is
+         when N_Attribute_Reference |
+
+            --  Nothing to do if we are the prefix of an attribute, since we
+            --  do not want an atomic sync operation for things like 'Size.
+
+              N_Reference           |
+
+            --  Likewise for a mere reference
+
+              N_Indexed_Component   |
+              N_Selected_Component  |
+              N_Slice               =>
+
+            --  The C.6(15) clause says that only reads and updates of the
+            --  object as a whole require atomic synchronization.
+
+            if Prefix (Parent (N)) = N then
+               return;
+            end if;
+
+         when others => null;
+      end case;
 
       --  Go ahead and set the flag
 
index 1ba4cf8..ed454ce 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2002-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-2011, 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- --
@@ -97,7 +97,7 @@ package body GNAT.Exception_Actions is
 
    function Name_To_Id (Name : String) return Exception_Id is
    begin
-      return To_Id (Internal_Exception (Name, False));
+      return To_Id (Internal_Exception (Name, Create_If_Not_Exist => False));
    end Name_To_Id;
 
    ---------------------------------
index 98a57e2..34346e3 100644 (file)
@@ -5013,12 +5013,16 @@ package body Sem_Ch10 is
 
                --  Set entity of parent identifiers if the unit is a child
                --  unit. This ensures that the tree is properly formed from
-               --  semantic point of view (e.g. for ASIS queries).
+               --  semantic point of view (e.g. for ASIS queries). The unit
+               --  entities are not fully analyzed, so we need to follow unit
+               --  links in the tree.
 
                Set_Entity (Nam, Ent);
 
                Nam := Prefix (Nam);
-               Ent := Scope (Ent);
+               Ent :=
+                 Defining_Entity
+                   (Unit (Parent_Spec (Unit_Declaration_Node (Ent))));
 
                --  Set entity of last ancestor
 
index 1b0f919..2ddf1af 100644 (file)
@@ -2429,8 +2429,17 @@ package body Sem_Ch5 is
             --  The type of the loop variable is the Iterator_Element aspect of
             --  the container type.
 
-            Set_Etype (Def_Id,
-              Entity (Find_Aspect (Typ, Aspect_Iterator_Element)));
+            declare
+               Element : constant Entity_Id :=
+                 Find_Aspect (Typ, Aspect_Iterator_Element);
+            begin
+               if No (Element) then
+                  Error_Msg_NE ("cannot iterate over&", N, Typ);
+                  return;
+               else
+                  Set_Etype (Def_Id, Entity (Element));
+               end if;
+            end;
 
          else
             --  For an iteration of the form IN, the name must denote an
@@ -2440,12 +2449,18 @@ package body Sem_Ch5 is
             if Is_Entity_Name (Original_Node (Name (N)))
               and then not Is_Iterator (Typ)
             then
-               Error_Msg_N
-                 ("name must be an iterator, not a container", Name (N));
+               if No (Find_Aspect (Typ, Aspect_Iterator_Element)) then
+                  Error_Msg_NE
+                    ("cannot iterate over&", Name (N), Typ);
+               else
+
+                  Error_Msg_N
+                    ("name must be an iterator, not a container", Name (N));
+               end if;
 
                Error_Msg_NE
-                 ("\to iterate directly over a container, write `of &`",
-                    Name (N), Original_Node (Name (N)));
+                 ("\to iterate directly over the elements of a container, " &
+                   "write `of &`", Name (N), Original_Node (Name (N)));
             end if;
 
             --  The result type of Iterate function is the classwide type of