diff options
| author | Steve Baird <baird@adacore.com> | 2020-08-18 13:51:37 -0700 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-10-22 08:11:24 -0400 |
| commit | 29f2d76c65e175e18305b92f56be40c2266e9c78 (patch) | |
| tree | 0f87c8423657c3f90c7e03fab8fd5ab68d436e60 /gcc/ada/exp_tss.adb | |
| parent | 46e54783503c30aecb7e36e6034f915ffc479d33 (diff) | |
| download | gcc-29f2d76c65e175e18305b92f56be40c2266e9c78.zip gcc-29f2d76c65e175e18305b92f56be40c2266e9c78.tar.gz gcc-29f2d76c65e175e18305b92f56be40c2266e9c78.tar.bz2 | |
[Ada] Implement AI12-0030: Stream attribute availability
gcc/ada/
* sem_util.ads, sem_util.adb: Declare and implement a new
predicate, Derivation_Too_Early_To_Inherit. This function
indicates whether a given derived type fails to inherit a given
streaming-related attribute from its parent type because the
declaration of the derived type precedes the corresponding
attribute_definition_clause of the parent.
* exp_tss.adb (Find_Inherited_TSS): Call
Derivation_Too_Early_To_Inherit instead of unconditionally
assuming that a parent type's streaming attribute is available
for inheritance by an immediate descendant type.
* sem_attr.adb (Stream_Attribute_Available): Call
Derivation_Too_Early_To_Inherit instead of unconditionally
assuming that a parent type's streaming attribute is available
for inheritance by an immediate descendant type.
* exp_attr.adb (Default_Streaming_Unavailable): A new predicate;
given a type, indicates whether predefined (as opposed to
user-defined) streaming operations for the type should be
implemented by raising Program_Error.
(Expand_N_Attribute_Reference): For each of the 4
streaming-related attributes (i.e., Read, Write, Input, Output),
after determining that no user-defined implementation is
available (including a Stream_Convert pragma), call
Default_Streaming_Unavailable; if that call returns True, then
implement the streaming operation as "raise Program_Error;".
Diffstat (limited to 'gcc/ada/exp_tss.adb')
| -rw-r--r-- | gcc/ada/exp_tss.adb | 8 |
1 files changed, 7 insertions, 1 deletions
diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb index b640843..40943fb 100644 --- a/gcc/ada/exp_tss.adb +++ b/gcc/ada/exp_tss.adb @@ -164,7 +164,13 @@ package body Exp_Tss is -- If Typ is a derived type, it may inherit attributes from an ancestor if No (Proc) and then Is_Derived_Type (Btyp) then - Proc := Find_Inherited_TSS (Etype (Btyp), Nam); + if not Derivation_Too_Early_To_Inherit (Btyp, Nam) then + Proc := Find_Inherited_TSS (Etype (Btyp), Nam); + elsif Is_Derived_Type (Etype (Btyp)) then + -- Skip one link in the derivation chain + Proc := Find_Inherited_TSS + (Etype (Base_Type (Etype (Btyp))), Nam); + end if; end if; -- If nothing else, use the TSS of the root type |