public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r11-1824] [Ada] AI12-0376 Relax RM 13.1(10) rule wrt primitive operations
@ 2020-07-06 11:39 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2020-07-06 11:39 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:f0c6bd6039459e984bbdebbf1abf231f64c9d1ca
commit r11-1824-gf0c6bd6039459e984bbdebbf1abf231f64c9d1ca
Author: Arnaud Charlet <charlet@adacore.com>
Date: Wed Apr 1 06:29:53 2020 -0400
[Ada] AI12-0376 Relax RM 13.1(10) rule wrt primitive operations
gcc/ada/
* aspects.ads (Is_Representation_Aspect):
Default_Component_Value is a representation aspect.
* sem_ch13.adb (Check_Aspect_Too_Late, Rep_Item_Too_Late): Relax
RM 13.1(10) rule wrt primitive operations for Ada 202x.
Diff:
---
gcc/ada/aspects.ads | 2 +-
gcc/ada/sem_ch13.adb | 71 ++++++++++++++++++++++++++--------------------------
2 files changed, 37 insertions(+), 36 deletions(-)
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 2c1245207f7..a418957c57c 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -454,7 +454,7 @@ package Aspects is
Aspect_Contract_Cases => False,
Aspect_Convention => True,
Aspect_CPU => False,
- Aspect_Default_Component_Value => False,
+ Aspect_Default_Component_Value => True,
Aspect_Default_Initial_Condition => False,
Aspect_Default_Iterator => False,
Aspect_Default_Storage_Pool => True,
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index c6a26146868..a0e5146e594 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -952,7 +952,6 @@ package body Sem_Ch13 is
procedure Check_Aspect_Too_Late (N : Node_Id) is
Typ : constant Entity_Id := Entity (N);
Expr : constant Node_Id := Expression (N);
- A_Id : constant Aspect_Id := Get_Aspect_Id (N);
function Find_Type_Reference
(Typ : Entity_Id; Expr : Node_Id) return Boolean;
@@ -995,42 +994,44 @@ package body Sem_Ch13 is
Parent_Type : Entity_Id;
begin
- if A_Id /= Aspect_Default_Value then
+ -- Ensure Expr is analyzed so that e.g. all types are properly
+ -- resolved for Find_Type_Reference.
- -- Ensure Expr is analyzed so that e.g. all types are properly
- -- resolved for Find_Type_Reference.
-
- Analyze (Expr);
+ Analyze (Expr);
- -- A self-referential aspect is illegal if it forces freezing the
- -- entity before the corresponding aspect has been analyzed.
+ -- A self-referential aspect is illegal if it forces freezing the
+ -- entity before the corresponding aspect has been analyzed.
- if Find_Type_Reference (Typ, Expr) then
- Error_Msg_NE
- ("aspect specification causes premature freezing of&",
- N, Typ);
- end if;
+ if Find_Type_Reference (Typ, Expr) then
+ Error_Msg_NE
+ ("aspect specification causes premature freezing of&", N, Typ);
end if;
-- For representation aspects, check for case of untagged derived
- -- type whose parent either has primitive operations, or is a by
- -- reference type (RM 13.1(10)).
+ -- type whose parent either has primitive operations (pre Ada 202x),
+ -- or is a by-reference type (RM 13.1(10)).
+ -- Strictly speaking the check also applies to Ada 2012 but it is
+ -- really too constraining for existing code already, so relax it.
+ -- ??? Confirming aspects should be allowed here.
- if Is_Representation_Aspect (A_Id)
+ if Is_Representation_Aspect (Get_Aspect_Id (N))
and then Is_Derived_Type (Typ)
and then not Is_Tagged_Type (Typ)
then
Parent_Type := Etype (Base_Type (Typ));
- if Has_Primitive_Operations (Parent_Type) then
- No_Type_Rep_Item (N);
+ if Ada_Version <= Ada_2012
+ and then Has_Primitive_Operations (Parent_Type)
+ then
+ Error_Msg_N
+ ("|representation aspect not permitted before Ada 202x!", N);
Error_Msg_NE
("\parent type & has primitive operations!", N, Parent_Type);
elsif Is_By_Reference_Type (Parent_Type) then
No_Type_Rep_Item (N);
Error_Msg_NE
- ("\parent type & is a by reference type!", N, Parent_Type);
+ ("\parent type & is a by-reference type!", N, Parent_Type);
end if;
end if;
end Check_Aspect_Too_Late;
@@ -13868,9 +13869,11 @@ package body Sem_Ch13 is
return True;
-- Check for case of untagged derived type whose parent either has
- -- primitive operations, or is a by reference type (RM 13.1(10)). In
- -- this case we do not output a Too_Late message, since there is no
- -- earlier point where the rep item could be placed to make it legal.
+ -- primitive operations (pre Ada 202x), or is a by-reference type (RM
+ -- 13.1(10)). In this case we do not output a Too_Late message, since
+ -- there is no earlier point where the rep item could be placed to make
+ -- it legal.
+ -- ??? Confirming representation clauses should be allowed here.
elsif Is_Type (T)
and then not FOnly
@@ -13879,24 +13882,22 @@ package body Sem_Ch13 is
then
Parent_Type := Etype (Base_Type (T));
- if Has_Primitive_Operations (Parent_Type) then
- No_Type_Rep_Item (N);
-
- if not Relaxed_RM_Semantics then
- Error_Msg_NE
- ("\parent type & has primitive operations!", N, Parent_Type);
- end if;
+ if Relaxed_RM_Semantics then
+ null;
+ elsif Ada_Version <= Ada_2012
+ and then Has_Primitive_Operations (Parent_Type)
+ then
+ Error_Msg_N
+ ("|representation item not permitted before Ada 202x!", N);
+ Error_Msg_NE
+ ("\parent type & has primitive operations!", N, Parent_Type);
return True;
elsif Is_By_Reference_Type (Parent_Type) then
No_Type_Rep_Item (N);
-
- if not Relaxed_RM_Semantics then
- Error_Msg_NE
- ("\parent type & is a by reference type!", N, Parent_Type);
- end if;
-
+ Error_Msg_NE
+ ("\parent type & is a by-reference type!", N, Parent_Type);
return True;
end if;
end if;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-07-06 11:39 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-07-06 11:39 [gcc r11-1824] [Ada] AI12-0376 Relax RM 13.1(10) rule wrt primitive operations Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).