public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/c++-coroutines] [Ada] Enable Put_Image in pre-Ada-2020 modes
@ 2020-06-12 18:48 Iain D Sandoe
0 siblings, 0 replies; only message in thread
From: Iain D Sandoe @ 2020-06-12 18:48 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:a3483a77e5dd55112bd97543c8dd00275c16b345
commit a3483a77e5dd55112bd97543c8dd00275c16b345
Author: Bob Duff <duff@adacore.com>
Date: Fri Mar 27 08:26:19 2020 -0400
[Ada] Enable Put_Image in pre-Ada-2020 modes
2020-06-12 Bob Duff <duff@adacore.com>
gcc/ada/
* exp_attr.adb (Put_Image): Remove assertion. This assertion is
False in mixed-Ada-version programs.
* exp_put_image.adb (Tagged_Put_Image_Enabled): New flag to make
it easy to experiment with Put_Image on tagged types. False in
this version.
(Enable_Put_Image): Enable in pre-2020. Workarounds: Disable
for tagged types if Tagged_Put_Image_Enabled is False. Disable
for access-to-subprogram types. Disable if errors have been
detected, or Sink is unavailable.
(Preload_Sink): Move all conditionals here, from Sem_Ch10, so
they can be nearby related code in Enable_Put_Image. Load Sink
only if we have seen a tagged type. This removes the dilemma
about calling Preload_Sink when compiling the compiler, which
caused unwanted dependences.
* exp_put_image.ads (Preload_Sink): New formal Compilation_Unit,
needed to move all conditionals here, from Sem_Ch10.
* libgnat/a-stouut.adb (Put_UTF_8): Make this suitable for
inlining, so we don't get warnings about inlining in some tests.
And so it can be inlined!
* opt.ads (Tagged_Seen): New flag (see Preload_Sink).
* scng.adb (Scan): Set new Tagged_Seen flag.
* sem_ch10.adb (Analyze_Compilation_Unit): Move conditionals and
comments regarding Preload_Sink into Preload_Sink.
Diff:
---
gcc/ada/exp_attr.adb | 3 ---
gcc/ada/exp_put_image.adb | 52 +++++++++++++++++++++++++++++++++++++-------
gcc/ada/exp_put_image.ads | 10 ++++-----
gcc/ada/libgnat/a-stouut.adb | 29 ++++++++++++++++--------
gcc/ada/opt.ads | 4 ++++
gcc/ada/scng.adb | 6 +++++
gcc/ada/sem_ch10.adb | 11 +---------
7 files changed, 80 insertions(+), 35 deletions(-)
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index fc7aefadf28..5faa1cee01a 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -5471,9 +5471,6 @@ package body Exp_Attr is
if No (Pname) then
if Is_Tagged_Type (U_Type) and then Is_Derived_Type (U_Type) then
Pname := Find_Optional_Prim_Op (U_Type, TSS_Put_Image);
- pragma Assert
- (Has_Interfaces (U_Type) -- ????interfaces not yet supported
- or else Enable_Put_Image (U_Type) = Present (Pname));
else
Pname := Find_Inherited_TSS (U_Type, TSS_Put_Image);
end if;
diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index 286640d2552..0d1325890b2 100644
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -44,6 +44,9 @@ with Uintp; use Uintp;
package body Exp_Put_Image is
+ Tagged_Put_Image_Enabled : constant Boolean := False;
+ -- ???Set True to enable Put_Image for at least some tagged types
+
-----------------------
-- Local Subprograms --
-----------------------
@@ -816,12 +819,6 @@ package body Exp_Put_Image is
function Enable_Put_Image (Typ : Entity_Id) return Boolean is
begin
- -- Disable in pre-2020 versions for now???
-
- if Ada_Version < Ada_2020 then
- return False;
- end if;
-
-- There's a bit of a chicken&egg problem. The compiler is likely to
-- have trouble if we refer to the Put_Image of Sink itself, because
-- Sink is part of the parameter profile:
@@ -846,14 +843,37 @@ package body Exp_Put_Image is
-- Put_Image on tagged types triggers some bugs.
--
-- Put_Image doesn't work for private types whose full type is real.
+ -- Disable for all real types, for simplicity.
+ --
+ -- Put_Image doesn't work for access-to-protected types, because of
+ -- confusion over their size. Disable for all access-to-subprogram
+ -- types, just in case.
if Is_Remote_Types (Scope (Typ))
or else (Is_Tagged_Type (Typ) and then In_Predefined_Unit (Typ))
+ or else (Is_Tagged_Type (Typ) and then not Tagged_Put_Image_Enabled)
or else Is_Real_Type (Typ)
+ or else Is_Access_Subprogram_Type (Typ)
then
return False;
end if;
+ -- End of workarounds.
+
+ -- No sense in generating code for Put_Image if there are errors. This
+ -- avoids certain cascade errors.
+
+ if Total_Errors_Detected > 0 then
+ return False;
+ end if;
+
+ -- If type Sink is unavailable in this runtime, disable Put_Image
+ -- altogether.
+
+ if No_Run_Time_Mode or else not RTE_Available (RE_Sink) then
+ return False;
+ end if;
+
-- ???Disable Put_Image on type Sink declared in
-- Ada.Strings.Text_Output. Note that we can't call Is_RTU on
-- Ada_Strings_Text_Output, because it's not known yet (we might be
@@ -911,9 +931,25 @@ package body Exp_Put_Image is
-- Preload_Sink --
------------------
- procedure Preload_Sink is
+ procedure Preload_Sink (Compilation_Unit : Node_Id) is
begin
- if RTE_Available (RE_Sink) then
+ -- We can't call RTE (RE_Sink) for at least some predefined units,
+ -- because it would introduce cyclic dependences. The package where Sink
+ -- is declared, for example, and things it depends on.
+ --
+ -- It's only needed for tagged types, so don't do it unless Put_Image is
+ -- enabled for tagged types, and we've seen a tagged type. Note that
+ -- Tagged_Seen is set True by the parser if the "tagged" reserved word
+ -- is seen; this flag tells us whether we have any tagged types.
+ --
+ -- Don't do it if type Sink is unavailable in the runtime.
+
+ if not In_Predefined_Unit (Compilation_Unit)
+ and then Tagged_Put_Image_Enabled
+ and then Tagged_Seen
+ and then not No_Run_Time_Mode
+ and then RTE_Available (RE_Sink)
+ then
declare
Ignore : constant Entity_Id := RTE (RE_Sink);
begin
diff --git a/gcc/ada/exp_put_image.ads b/gcc/ada/exp_put_image.ads
index 6b5f6b05dd1..3ee8f8b42cc 100644
--- a/gcc/ada/exp_put_image.ads
+++ b/gcc/ada/exp_put_image.ads
@@ -85,10 +85,10 @@ package Exp_Put_Image is
function Build_Unknown_Put_Image_Call (N : Node_Id) return Node_Id;
-- Build a call to Put_Image_Unknown
- procedure Preload_Sink;
- -- Call RTE (RE_Sink), to load the packages involved in Put_Image. We
- -- need to do this explicitly, fairly early during compilation, because
- -- otherwise it happens during freezing, which triggers visibility bugs
- -- in generic instantiations.
+ procedure Preload_Sink (Compilation_Unit : Node_Id);
+ -- Call RTE (RE_Sink) if necessary, to load the packages involved in
+ -- Put_Image. We need to do this explicitly, fairly early during
+ -- compilation, because otherwise it happens during freezing, which
+ -- triggers visibility bugs in generic instantiations.
end Exp_Put_Image;
diff --git a/gcc/ada/libgnat/a-stouut.adb b/gcc/ada/libgnat/a-stouut.adb
index 9d5d163ab9d..89d6c6e298f 100644
--- a/gcc/ada/libgnat/a-stouut.adb
+++ b/gcc/ada/libgnat/a-stouut.adb
@@ -40,6 +40,10 @@ package body Ada.Strings.Text_Output.Utils is
procedure Adjust_Column (S : in out Sink'Class) with Inline;
-- Adjust the column for a non-NL character.
+ procedure Put_UTF_8_Outline (S : in out Sink'Class; Item : UTF_8);
+ -- Out-of-line portion of Put_UTF_8. This exists solely to make Put_UTF_8
+ -- small enough to reasonably inline it.
+
procedure Full (S : in out Sink'Class) is
begin
pragma Assert (S.Last = S.Chunk_Length);
@@ -132,16 +136,9 @@ package body Ada.Strings.Text_Output.Utils is
end if;
end Put_Wide_Wide_Character;
- procedure Put_UTF_8 (S : in out Sink'Class; Item : UTF_8) is
+ procedure Put_UTF_8_Outline (S : in out Sink'Class; Item : UTF_8) is
begin
- Adjust_Column (S);
-
- if S.Last + Item'Length < S.Chunk_Length then
- -- Item fits in current chunk
-
- S.Cur_Chunk.Chars (S.Last + 1 .. S.Last + Item'Length) := Item;
- S.Last := S.Last + Item'Length;
- elsif S.Last + Item'Length = S.Chunk_Length then
+ if S.Last + Item'Length = S.Chunk_Length then
-- Item fits exactly in current chunk
S.Cur_Chunk.Chars (S.Last + 1 .. S.Last + Item'Length) := Item;
@@ -168,6 +165,20 @@ package body Ada.Strings.Text_Output.Utils is
Put_UTF_8 (S, Right); -- This might call Full, but probably not.
end;
end if;
+ end Put_UTF_8_Outline;
+
+ procedure Put_UTF_8 (S : in out Sink'Class; Item : UTF_8) is
+ begin
+ Adjust_Column (S);
+
+ if S.Last + Item'Length < S.Chunk_Length then
+ -- Item fits in current chunk
+
+ S.Cur_Chunk.Chars (S.Last + 1 .. S.Last + Item'Length) := Item;
+ S.Last := S.Last + Item'Length;
+ else
+ Put_UTF_8_Outline (S, Item);
+ end if;
end Put_UTF_8;
procedure Put_UTF_8_Lines (S : in out Sink'Class; Item : UTF_8_Lines) is
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index b25266ae07a..864b60b18db 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -2178,6 +2178,10 @@ package Opt is
-- be in the spec of Expander, but it is referenced by Errout, and it
-- really seems wrong for Errout to depend on Expander.
+ Tagged_Seen : Boolean := False;
+ -- Set True by the parser if the "tagged" reserved word is seen. This is
+ -- needed in Exp_Put_Image (see that package for documentation).
+
-----------------------------------
-- Modes for Formal Verification --
-----------------------------------
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index 46d1f8ef5a7..fd3dacc9af1 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -2568,6 +2568,12 @@ package body Scng is
Accumulate_Token_Checksum;
Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
+ -- See Exp_Put_Image for documentation of Tagged_Seen
+
+ if Token = Tok_Tagged then
+ Tagged_Seen := True;
+ end if;
+
-- Keyword style checks
if Style_Check then
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index a4de98bade5..28f4674ceeb 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -622,16 +622,7 @@ package body Sem_Ch10 is
-- Start of processing for Analyze_Compilation_Unit
begin
- -- We can't call Preload_Sink for at least some predefined units,
- -- because it would introduce cyclic dependences. The package where Sink
- -- is declared, for example, and things it depends on. See Exp_Put_Image
- -- for documentation. We don't call Preload_Sink in pre-2020 Ada
- -- versions, because the default Put_Image is disabled in those
- -- versions, at least for now.
-
- if Ada_Version >= Ada_2020 and then not In_Predefined_Unit (N) then
- Exp_Put_Image.Preload_Sink;
- end if;
+ Exp_Put_Image.Preload_Sink (N);
Process_Compilation_Unit_Pragmas (N);
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-06-12 18:48 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-06-12 18:48 [gcc/devel/c++-coroutines] [Ada] Enable Put_Image in pre-Ada-2020 modes Iain D Sandoe
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).