[multiple changes]

2011-11-21  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, sem_util.adb, sem_res.adb, sem_attr.adb: Minor
	reformatting.

2011-11-21  Arnaud Charlet  <charlet@adacore.com>

	* s-taprop-posix.adb (Create_Task): Use Unrestricted_Access
	to deal with fact that we properly detect the error if Access
	is used.

From-SVN: r181572

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ad67de5d4a9683fc1743cb993fdc02305f9e182d..fe786073a02fc05188d816adb23b5fc9068d8fb7 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,14 @@
+2011-11-21  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch3.adb, sem_util.adb, sem_res.adb, sem_attr.adb: Minor
+       reformatting.
+
+2011-11-21  Arnaud Charlet  <charlet@adacore.com>
+
+       * s-taprop-posix.adb (Create_Task): Use Unrestricted_Access
+       to deal with fact that we properly detect the error if Access
+       is used.
+
 2011-11-21  Steve Baird  <baird@adacore.com>
 
        * sem_util.ads: Update comment describing function

diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb
index 425508a32c2f0f27c13c75ca82e9bbd3fce48ed5..44015cf85d5ad194e5a2ddd5646f3146f74fc02d 100644 (file)
--- a/gcc/ada/s-taprop-posix.adb
+++ b/gcc/ada/s-taprop-posix.adb
@@ -975,8 +975,14 @@ package body System.Task_Primitives.Operations is
       --  do not need to manipulate caller's signal mask at this point.
       --  All tasks in RTS will have All_Tasks_Mask initially.
 
+      --  Note: the use of Unrestricted_Access in the following call is needed
+      --  because otherwise we have an error of getting a access-to-volatile
+      --  value which points to a non-volatile object. But in this case it is
+      --  safe to do this, since we know we have no problems with aliasing and
+      --  Unrestricted_Access bypasses this check.
+
       Result := pthread_create
-        (T.Common.LL.Thread'Access,
+        (T.Common.LL.Thread'Unrestricted_Access,
          Attributes'Access,
          Thread_Body_Access (Wrapper),
          To_Address (T));

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 4005ba2426a2d58f062130bf8b56431ace2bebf4..ac8bb8344b97ac030dad9abc37e590d5cefc967c 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -8642,10 +8642,10 @@ package body Sem_Attr is
                   end if;
                end if;
 
-               --  Check the static accessibility rule of 3.10.2(28).
-               --  Note that this check is not performed for the
-               --  case of an anonymous access type, since the access
-               --  attribute is always legal in such a context.
+               --  Check the static accessibility rule of 3.10.2(28). Note that
+               --  this check is not performed for the case of an anonymous
+               --  access type, since the access attribute is always legal
+               --  in such a context.
 
                if Attr_Id /= Attribute_Unchecked_Access
                  and then

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 3587e07685a7b10770a0451a9f7f300d3837ff95..92e1b9da994f6625e137780c1d441a32a1208bde 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1897,7 +1897,8 @@ package body Sem_Ch3 is
             --  components
 
             if Type_Access_Level (Etype (E)) >
-              Deepest_Type_Access_Level (T) then
+               Deepest_Type_Access_Level (T)
+            then
                Error_Msg_N
                  ("expression has deeper access level than component " &
                   "(RM 3.10.2 (12.2))", E);

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 30421af048f97f5f076898203221985f161a797b..e45be653cbca364d3d44de9b0310affdae0f9ad7 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4095,10 +4095,10 @@ package body Sem_Res is
          --  object must not be deeper than that of the allocator's type.
 
          elsif Nkind (Disc_Exp) = N_Attribute_Reference
-           and then Get_Attribute_Id (Attribute_Name (Disc_Exp))
-                      = Attribute_Access
-           and then Object_Access_Level (Prefix (Disc_Exp))
-                      > Deepest_Type_Access_Level (Alloc_Typ)
+           and then Get_Attribute_Id (Attribute_Name (Disc_Exp)) =
+                      Attribute_Access
+           and then Object_Access_Level (Prefix (Disc_Exp)) >
+                      Deepest_Type_Access_Level (Alloc_Typ)
          then
             Error_Msg_N
               ("prefix of attribute has deeper level than allocator type",
@@ -4109,8 +4109,8 @@ package body Sem_Res is
 
          elsif Ekind (Etype (Disc_Exp)) = E_Anonymous_Access_Type
            and then Nkind (Disc_Exp) = N_Selected_Component
-           and then Object_Access_Level (Prefix (Disc_Exp))
-                      > Deepest_Type_Access_Level (Alloc_Typ)
+           and then Object_Access_Level (Prefix (Disc_Exp)) >
+                      Deepest_Type_Access_Level (Alloc_Typ)
          then
             Error_Msg_N
               ("access discriminant has deeper level than allocator type",
@@ -4315,7 +4315,8 @@ package body Sem_Res is
             end if;
 
             if Type_Access_Level (Exp_Typ) >
-              Deepest_Type_Access_Level (Typ) then
+                 Deepest_Type_Access_Level (Typ)
+            then
                if In_Instance_Body then
                   Error_Msg_N ("?type in allocator has deeper level than" &
                                " designated class-wide type", E);
@@ -10359,13 +10360,15 @@ package body Sem_Res is
                 Subtypes_Statically_Match (Target_Comp_Type, Opnd_Comp_Type)
             then
                if Type_Access_Level (Target_Type) <
-                   Deepest_Type_Access_Level (Opnd_Type)
+                    Deepest_Type_Access_Level (Opnd_Type)
                then
                   if In_Instance_Body then
-                     Error_Msg_N ("?source array type " &
-                       "has deeper accessibility level than target", Operand);
-                     Error_Msg_N ("\?Program_Error will be raised at run time",
-                         Operand);
+                     Error_Msg_N
+                       ("?source array type has " &
+                        "deeper accessibility level than target", Operand);
+                     Error_Msg_N
+                       ("\?Program_Error will be raised at run time",
+                        Operand);
                      Rewrite (N,
                        Make_Raise_Program_Error (Sloc (N),
                          Reason => PE_Accessibility_Check_Failed));
@@ -10375,8 +10378,9 @@ package body Sem_Res is
                   --  Conversion not allowed because of accessibility levels
 
                   else
-                     Error_Msg_N ("source array type " &
-                       "has deeper accessibility level than target", Operand);
+                     Error_Msg_N
+                       ("source array type has " &
+                       "deeper accessibility level than target", Operand);
                      return False;
                   end if;
 
@@ -10399,7 +10403,7 @@ package body Sem_Res is
             --  All of this is checked in Subtypes_Statically_Match.
 
             if not Subtypes_Statically_Match
-                            (Target_Comp_Type, Opnd_Comp_Type)
+                     (Target_Comp_Type, Opnd_Comp_Type)
             then
                Error_Msg_N
                  ("component subtypes must statically match", Operand);

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c3fe8f9bbfaa80765396d1a71f43e6ee25f5c4bc..8e6a2a2fa36ccd5c4eaf36d68b4e435d56f8457f 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2437,6 +2437,8 @@ package body Sem_Util is
                          (Defining_Identifier
                            (Associated_Node_For_Itype (Typ))));
 
+      --  For generic formal type, return Int'Last (infinite) (why ???)
+
       elsif Is_Generic_Type (Root_Type (Typ)) then
          return UI_From_Int (Int'Last);
 
@@ -12717,6 +12719,8 @@ package body Sem_Util is
          end if;
       end if;
 
+      --  Return library level for a generic formal type (why???)
+
       if Is_Generic_Type (Root_Type (Btyp)) then
          return Scope_Depth (Standard_Standard);
       end if;