[multiple changes]

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* sem_ch7.adb, make.adb, sem_res.adb, exp_intr.adb,
	exp_dist.adb: Minor code reorganization.
	Minor reformatting.

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* sem_cat.adb (Validate_RACW_Primitive): The return type of an RACW
	primitive operation must support external streaming if it is not a
	controlling access result.

From-SVN: r178199

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9a8e2dcd4f6c88ceb35b0a0f5a0afd443376d172..e906a4b94868b3e03a6dda594f211310819ff4f7 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch7.adb, make.adb, sem_res.adb, exp_intr.adb,
+       exp_dist.adb: Minor code reorganization.
+       Minor reformatting.
+
+2011-08-29  Thomas Quinot  <quinot@adacore.com>
+
+       * sem_cat.adb (Validate_RACW_Primitive): The return type of an RACW
+       primitive operation must support external streaming if it is not a
+       controlling access result.
+
 2011-08-29  Thomas Quinot  <quinot@adacore.com>
 
        * sinfo.ads, sem_ch7.adb: Minor reformatting.

diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index e0c970c37cafdbca9aeed6d2fa269e1a49353ae7..df6ead34f9dded1eafbd0286ac79084ed846bf9f 100644 (file)
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -10539,6 +10539,7 @@ package body Exp_Dist is
                                           Expr :=
                                             Make_Integer_Literal (Loc, J);
                                        end if;
+
                                        Set_Etype (Expr, Disc_Type);
                                        Append_To (Union_TC_Params,
                                          Build_To_Any_Call (Expr, Decls));
@@ -10566,8 +10567,9 @@ package body Exp_Dist is
                                            (RTE (RE_TA_I32), Loc),
                                        Parameter_Associations =>
                                          New_List (
-                                           Make_Integer_Literal
-                                             (Loc, Choice_Index)));
+                                           Make_Integer_Literal (Loc,
+                                             Intval => Choice_Index)));
+
                                  begin
                                     Insert_Before
                                       (Default_Node, New_Default_Node);
@@ -10581,10 +10583,10 @@ package body Exp_Dist is
 
                                  declare
                                     Exp : constant Node_Id :=
-                                      Make_Attribute_Reference (Loc,
-                                       Prefix         => New_Occurrence_Of
-                                                           (Disc_Type, Loc),
-                                       Attribute_Name => Name_First);
+                                            Make_Attribute_Reference (Loc,
+                                              Prefix => New_Occurrence_Of
+                                                          (Disc_Type, Loc),
+                                              Attribute_Name => Name_First);
                                  begin
                                     Set_Etype (Exp, Disc_Type);
                                     Append_To (Union_TC_Params,

diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index 778996bc023e55068c2d4b27e9995df9649f25f0..ce05b42b30f61cad17302bbf52b3067a86ee060a 100644 (file)
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -1229,13 +1229,13 @@ package body Exp_Intr is
       --  Generate a test of whether any earlier finalization raised an
       --  exception, and in that case raise Program_Error with the previous
       --  exception occurrence.
-      --
+
       --  Generate:
-      --    if Raised then
-      --       Reraise_Occurrence (E);                      --  for .NET and
-      --                                                    --  restricted RTS
+      --    if Raised and then not Abort then
+      --       Reraise_Occurrence (E);               --  for .NET and
+      --                                             --  restricted RTS
       --         <or>
-      --       Raise_From_Controlled_Operation (E, Abort);  --  all other cases
+      --       Raise_From_Controlled_Operation (E);  --  all other cases
       --    end if;
 
       if Present (Raised_Id) then

diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index d64975d21a31423eaba5ecb32f7d14b1fad2ff99..7b9087f4bc3e40e2b90f6e0e9adecd13d1d5938a 100644 (file)
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -6109,19 +6109,20 @@ package body Make is
                --  Set proper processing commands
 
                case Targparm.VM_Target is
-               when Targparm.JVM_Target =>
+                  when Targparm.JVM_Target =>
 
-                  --  Do not check for an object file (".o") when compiling to
-                  --  JVM machine since ".class" files are generated instead.
+                     --  Do not check for an object file (".o") when compiling
+                     --  to JVM machine since ".class" files are generated
+                     --  instead.
 
-                  Check_Object_Consistency := False;
-                  Gcc := new String'("jvm-gnatcompile");
+                     Check_Object_Consistency := False;
+                     Gcc := new String'("jvm-gnatcompile");
 
-               when Targparm.CLI_Target =>
-                  Gcc := new String'("dotnet-gnatcompile");
+                  when Targparm.CLI_Target =>
+                     Gcc := new String'("dotnet-gnatcompile");
 
-               when Targparm.No_VM =>
-                  raise Program_Error;
+                  when Targparm.No_VM =>
+                     raise Program_Error;
                end case;
             end if;
 

diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index 7b0a1fb822479bc8db26f44e8772d26b268e2ca3..58aaee1d573cb3638b01d7528bc879dd4401c202 100644 (file)
--- a/gcc/ada/sem_cat.adb
+++ b/gcc/ada/sem_cat.adb
@@ -1391,6 +1391,10 @@ package body Sem_Cat is
       if Ekind (Subp) = E_Function then
          Rtyp := Etype (Subp);
 
+         --  AI05-0101 (Binding Interpretation): The result type of a remote
+         --  function must either support external streaming or be a
+         --  controlling access result type.
+
          if Has_Controlling_Result (Subp) then
             null;
 
@@ -1406,19 +1410,16 @@ package body Sem_Cat is
                  ("limited return type must have Read and Write attributes",
                      Parent (Subp));
                Explain_Limited_Type (Rtyp, Parent (Subp));
+            end if;
 
-            --  Check that the return type supports external streaming.
-            --  Note that the language of the standard (E.2.2(14)) does not
-            --  explicitly mention that case, but it really does not make
-            --  sense to return a value containing a local access type.
+         --  Check that the return type supports external streaming
 
-            elsif No_External_Streaming (Rtyp)
-                    and then not Error_Posted (Rtyp)
-            then
-               Illegal_Remote_Subp ("return type containing non-remote access "
-                 & "must have Read and Write attributes",
-                 Parent (Subp));
-            end if;
+         elsif No_External_Streaming (Rtyp)
+                 and then not Error_Posted (Rtyp)
+         then
+            Illegal_Remote_Subp ("return type containing non-remote access "
+              & "must have Read and Write attributes",
+              Parent (Subp));
          end if;
       end if;
 
@@ -1674,13 +1675,8 @@ package body Sem_Cat is
          then
             return True;
 
-         --  A limited interface is not currently a legal ancestor for the
-         --  designated type of an RACW type, because a type that implements
-         --  such an interface need not be limited. However, the ARG seems to
-         --  incline towards allowing an access to classwide limited interface
-         --  type as a remote access type, as resolved in AI05-060. But note
-         --  that the expansion circuitry for RACWs that designate classwide
-         --  interfaces is not complete yet.
+         --  AI05-0060 (Binding Interpretation): A limited interface is a legal
+         --  ancestor for the designated type of an RACW type.
 
          elsif Is_Limited_Record (E) and then Is_Limited_Interface (E) then
             return True;

diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 8cf1170df5bae2e727e938a35ed949ae98aa6a25..e1453d0c1e8e329572d48a5b5eaa05324cd9dedc 100644 (file)
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1196,7 +1196,7 @@ package body Sem_Ch7 is
 
          --  Check on incomplete types
 
-         --  AI05-0213: a formal incomplete type has no completion
+         --  AI05-0213: A formal incomplete type has no completion
 
          if Ekind (E) = E_Incomplete_Type
            and then No (Full_View (E))

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index ff54fe9a3f7530009d82f4608cf15ca108ff0053..e552c668560d8b40d415387f6afd7b6f63508126 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4059,7 +4059,7 @@ package body Sem_Res is
 
    procedure Resolve_Allocator (N : Node_Id; Typ : Entity_Id) is
       Desig_T  : constant Entity_Id := Designated_Type (Typ);
-      E        : constant Node_Id := Expression (N);
+      E        : constant Node_Id   := Expression (N);
       Subtyp   : Entity_Id;
       Discrim  : Entity_Id;
       Constr   : Node_Id;
@@ -4387,6 +4387,7 @@ package body Sem_Res is
             declare
                Discr : constant Entity_Id :=
                          Defining_Identifier (Associated_Node_For_Itype (Typ));
+
             begin
                --  Ada 2012 AI05-0052: If the designated type of the allocator
                --  is limited, then the allocator shall not be used to define