aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog12
-rw-r--r--gcc/ada/exp_dist.adb14
-rw-r--r--gcc/ada/exp_intr.adb10
-rw-r--r--gcc/ada/make.adb19
-rw-r--r--gcc/ada/sem_cat.adb32
-rw-r--r--gcc/ada/sem_ch7.adb2
-rw-r--r--gcc/ada/sem_res.adb3
7 files changed, 52 insertions, 40 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9a8e2dc..e906a4b 100644
--- 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 e0c970c..df6ead3 100644
--- 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 778996b..ce05b42 100644
--- 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 d64975d..7b9087f 100644
--- 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 7b0a1fb..58aaee1 100644
--- 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 8cf1170..e1453d0 100644
--- 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 ff54fe9..e552c66 100644
--- 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
generated by cgit v1.1 at 2025-03-01 04:58:51 +0000