From a91b983325449c68f2f497a1662a4b85c47ce1a9 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 13 Mar 2020 13:05:13 -0400 Subject: [PATCH] [Ada] Put_Image attribute 2020-06-11 Bob Duff gcc/ada/ * exp_put_image.adb (Build_Record_Put_Image_Procedure): Remove special processing of protected types, because those are handled by Build_Protected_Put_Image_Call. (Enable_Put_Image): Use the switch -gnatd_z to control enabling of Put_Image. Disable Put_Image for types in Remote_Types packages. * debug.adb: Document -gnatd_z switch. * exp_imgv.adb, libgnat/a-stteou.ads, opt.ads: Minor cleanups. --- gcc/ada/debug.adb | 5 ++++- gcc/ada/exp_imgv.adb | 2 +- gcc/ada/exp_put_image.adb | 37 +++++++++++++++++++++---------------- gcc/ada/libgnat/a-stteou.ads | 2 +- gcc/ada/opt.ads | 6 +++--- 5 files changed, 30 insertions(+), 22 deletions(-) diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 1d614eb..0c86d96 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -170,7 +170,7 @@ package body Debug is -- d_w -- d_x -- d_y - -- d_z + -- d_z Enable Put_Image -- d_A Stop generation of ALI file -- d_B @@ -993,6 +993,9 @@ package body Debug is -- a call to routine Ada.Synchronous_Task_Control.Suspend_Until_True -- or Ada.Synchronous_Barriers.Wait_For_Release. + -- d_z The Put_Image attribute is a work in progress, and is disabled by + -- default. This enables it. + -- d_A Do not generate ALI files by setting Opt.Disable_ALI_File. -- d_F The compiler encodes the full path from an invocation construct to diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 4f2a67f..d7be8e4 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -747,7 +747,7 @@ package body Exp_Imgv is -- btyp (Value_xx (X)) - -- where btyp is he base type of the prefix + -- where btyp is the base type of the prefix -- For types whose root type is Character -- xx = Character diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index af6a783..3a6cbc1 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with Atree; use Atree; +with Debug; use Debug; with Einfo; use Einfo; with Exp_Tss; use Exp_Tss; with Lib; use Lib; @@ -323,9 +324,14 @@ package body Exp_Put_Image is -- -- Put_Wide_Wide_String (Sink, U_Type'Wide_Wide_Image (Item)); -- - -- This is a bit of a cheat; we should probably do it the other way - -- around (define '[[Wide_]Wide_]Image in terms of 'Put_Image). But - -- this is expedient for now. We can't do this: + -- It would be more elegant to do it the other way around (define + -- '[[Wide_]Wide_]Image in terms of 'Put_Image). But this is easier + -- to implement, because we already have support for + -- 'Wide_Wide_Image. Furthermore, we don't want to remove the + -- existing support for '[[Wide_]Wide_]Image, because we don't + -- currently plan to support 'Put_Image on restricted runtimes. + + -- We can't do this: -- -- Put_UTF_8 (Sink, U_Type'Image (Item)); -- @@ -689,22 +695,12 @@ package body Exp_Put_Image is Stms : constant List_Id := New_List; Rdef : Node_Id; - Typt : Entity_Id; - Type_Decl : Node_Id; + Type_Decl : constant Node_Id := + Declaration_Node (Base_Type (Underlying_Type (Typ))); -- Start of processing for Build_Record_Put_Image_Procedure begin - -- For the protected type case, use corresponding record - - if Is_Protected_Type (Typ) then - Typt := Corresponding_Record_Type (Typ); - else - Typt := Typ; - end if; - - Type_Decl := Declaration_Node (Base_Type (Underlying_Type (Typt))); - Append_To (Stms, Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (RTE (RE_Record_Before), Loc), @@ -813,7 +809,7 @@ package body Exp_Put_Image is function Enable_Put_Image (T : Entity_Id) return Boolean is begin - if True then -- ????True to disable for all types. + if not Debug_Flag_Underscore_Z then -- ????True to disable for all types return False; end if; @@ -832,6 +828,15 @@ package body Exp_Put_Image is -- scalar types are expanded inline. We certainly want to be able to use -- Integer'Put_Image, for example. + -- ???Work around a bug: Put_Image does not work for Remote_Types. + -- We check the containing package, rather than the type itself, because + -- we want to include types in the private part of a Remote_Types + -- package. + + if Is_Remote_Types (Scope (T)) 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 diff --git a/gcc/ada/libgnat/a-stteou.ads b/gcc/ada/libgnat/a-stteou.ads index 1240f4a..8aaee46 100644 --- a/gcc/ada/libgnat/a-stteou.ads +++ b/gcc/ada/libgnat/a-stteou.ads @@ -133,7 +133,7 @@ package Ada.Strings.Text_Output is (UTF_Encoding.Wide_Wide_Strings.Decode (UTF_8_Lines)) = UTF_8_Lines; subtype UTF_8 is UTF_8_Lines with - Predicate => (for all C of UTF_8 => C /= NL); + Predicate => (for all UTF_8_Char of UTF_8 => UTF_8_Char /= NL); Default_Indent_Amount : constant Natural := 4; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 8987f83..b08df8d 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -373,9 +373,9 @@ package Opt is Configurable_Run_Time_Mode : Boolean := False; -- GNAT, GNATBIND -- Set True if the compiler is operating in configurable run-time mode. - -- This happens if the flag Targparm.Configurable_Run_TimeMode_On_Target - -- is set True, or if pragma No_Run_Time is used. See the spec of Rtsfind - -- for details on the handling of the latter pragma. + -- This happens if the flag Targparm.Configurable_Run_Time_On_Target is + -- True, or if pragma No_Run_Time is used. See the spec of Rtsfind for + -- details on the handling of the latter pragma. Constant_Condition_Warnings : Boolean := False; -- GNAT -- 2.7.4