diff options
author | Justin Squirek <squirek@adacore.com> | 2021-07-19 15:13:49 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-09-22 15:01:45 +0000 |
commit | 4b54d9393e2af43393cce9b76798617b3c3452f1 (patch) | |
tree | 46fd90bdedb2564a12e0e3e86d1aff4904b8a17d /gcc | |
parent | cbf1ffe1252430f0db0db18b0b695799bb31c242 (diff) | |
download | gcc-4b54d9393e2af43393cce9b76798617b3c3452f1.zip gcc-4b54d9393e2af43393cce9b76798617b3c3452f1.tar.gz gcc-4b54d9393e2af43393cce9b76798617b3c3452f1.tar.bz2 |
[Ada] Removal of technical debt
gcc/ada/
* ali.adb, ali.ads (Scan_ALI): Remove use of deprecated
parameter Ignore_ED, and all specification for Lower in call to
Get_File_Name.
* ali-util.adb (Read_Withed_ALIs): Modify call to Scan_ALI.
* clean.adb (Clean_Executables): Likewise.
* gnatbind.adb (Add_Artificial_ALI_File, Executable section):
Likewise.
* gnatlink.adb (Executable section): Likewise.
* gnatls.adb (Executable section): Likewise.
* make.adb (Check, Wait_For_Available_Slot): Likewise.
* aspects.ads: Add Aspect_No_Controlled_Parts to
Nonoverridable_Aspect_Id
* opt.ads: Remove function pointers used as a workaround for
ASIS.
* osint-c.adb (Executable section): Remove setting of function
pointer workarounds needed for ASIS.
* osint.adb (Read_Default_Search_Dirs): Correct behavior to
detect EOL characters.
* par_sco.adb (Output_Header): Remove comment regarding use of
First_Sloc.
(Traverse_Sync_Definition): Renamed to
Traverse_Protected_Or_Task_Definition.
* pprint.adb (Interal_List_Name): Add description about purpose,
and refactor conditional statement.
(Prepend): Removed.
* repinfo.adb (List_Rep_Info, Write_Info_Line): Remove use of
subprogram pointer.
* scng.adb (Scan): Remove CODEFIX question, and minor comment
change.
* sem_attr.adb (Analyze_Image_Attribute): Remove special
processing for 'Img.
* sem_ch6.adb (Check_Untagged_Equality): Add RM reference.
(FCE): Add comment describing behavior.
(Is_Non_Overriding_Operation): Minor comment formatting change.
* sem_type.adb (Is_Actual_Subprogram): Add comment about
Comes_From_Source test.
(Matching_Types): Describe non-matching cases.
* sem_util.adb (Is_Confirming): Add stub case for
No_Controlled_Parts.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ali-util.adb | 1 | ||||
-rw-r--r-- | gcc/ada/ali.adb | 20 | ||||
-rw-r--r-- | gcc/ada/ali.ads | 6 | ||||
-rw-r--r-- | gcc/ada/aspects.ads | 2 | ||||
-rw-r--r-- | gcc/ada/clean.adb | 2 | ||||
-rw-r--r-- | gcc/ada/gnatbind.adb | 2 | ||||
-rw-r--r-- | gcc/ada/gnatlink.adb | 1 | ||||
-rw-r--r-- | gcc/ada/gnatls.adb | 1 | ||||
-rw-r--r-- | gcc/ada/make.adb | 4 | ||||
-rw-r--r-- | gcc/ada/opt.ads | 16 | ||||
-rw-r--r-- | gcc/ada/osint-c.adb | 4 | ||||
-rw-r--r-- | gcc/ada/osint.adb | 6 | ||||
-rw-r--r-- | gcc/ada/par_sco.adb | 23 | ||||
-rw-r--r-- | gcc/ada/pprint.adb | 59 | ||||
-rw-r--r-- | gcc/ada/repinfo.adb | 7 | ||||
-rw-r--r-- | gcc/ada/scng.adb | 6 | ||||
-rw-r--r-- | gcc/ada/sem_attr.adb | 8 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 10 | ||||
-rw-r--r-- | gcc/ada/sem_type.adb | 7 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 12 |
20 files changed, 60 insertions, 137 deletions
diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index 9074a9a..6c567c3 100644 --- a/gcc/ada/ali-util.adb +++ b/gcc/ada/ali-util.adb @@ -249,7 +249,6 @@ package body ALI.Util is Scan_ALI (F => Afile, T => Text, - Ignore_ED => False, Err => False); Free (Text); diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 24f1677..3815a70 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -892,7 +892,6 @@ package body ALI is function Scan_ALI (F : File_Name_Type; T : Text_Buffer_Ptr; - Ignore_ED : Boolean; Err : Boolean; Ignore_Lines : String := "X"; Ignore_Errors : Boolean := False; @@ -1319,8 +1318,7 @@ package body ALI is exit when Nextc = ','; -- Terminate if left bracket not part of wide char - -- sequence Note that we only recognize brackets - -- notation so far ??? + -- sequence. exit when Nextc = '[' and then T (P + 1) /= '"'; @@ -2938,9 +2936,7 @@ package body ALI is -- Store AD indication unless ignore required - if not Ignore_ED then - Withs.Table (Withs.Last).Elab_All_Desirable := True; - end if; + Withs.Table (Withs.Last).Elab_All_Desirable := True; elsif Nextc = 'E' then P := P + 1; @@ -2957,12 +2953,9 @@ package body ALI is Checkc ('D'); Check_At_End_Of_Field; - -- Store ED indication unless ignore required + -- Store ED indication - if not Ignore_ED then - Withs.Table (Withs.Last).Elab_Desirable := - True; - end if; + Withs.Table (Withs.Last).Elab_Desirable := True; end if; else @@ -3213,13 +3206,10 @@ package body ALI is Skip_Space; Sdep.Increment_Last; - -- In the following call, Lower is not set to True, this is either - -- a bug, or it deserves a special comment as to why this is so??? - -- The file/path name may be quoted Sdep.Table (Sdep.Last).Sfile := - Get_File_Name (May_Be_Quoted => True); + Get_File_Name (Lower => True, May_Be_Quoted => True); Sdep.Table (Sdep.Last).Stamp := Get_Stamp; Sdep.Table (Sdep.Last).Dummy_Entry := diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 3ac9f0e..175aea9 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -1389,7 +1389,6 @@ package ALI is function Scan_ALI (F : File_Name_Type; T : Text_Buffer_Ptr; - Ignore_ED : Boolean; Err : Boolean; Ignore_Lines : String := "X"; Ignore_Errors : Boolean := False; @@ -1399,11 +1398,6 @@ package ALI is -- table. Switch settings may be modified as described above in the -- switch description settings. -- - -- Ignore_ED is normally False. If set to True, it indicates that - -- all AD/ED (elaboration desirable) indications in the ALI file are - -- to be ignored. This parameter is obsolete now that the -f switch - -- is removed from gnatbind, and should be removed ??? - -- -- Err determines the action taken on an incorrectly formatted file. -- If Err is False, then an error message is output, and the program -- is terminated. If Err is True, then no error message is output, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 0f9ed23..7d0c703 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -233,7 +233,7 @@ package Aspects is Aspect_Implicit_Dereference | Aspect_Constant_Indexing | Aspect_Variable_Indexing | Aspect_Aggregate | Aspect_Max_Entry_Queue_Length - -- | Aspect_No_Controlled_Parts + | Aspect_No_Controlled_Parts -- ??? No_Controlled_Parts not yet in Aspect_Id enumeration ; -- see RM 13.1.1(18.7) diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 03ca7a4..830a994 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -217,7 +217,7 @@ package body Clean is if Text /= null then The_ALI := - Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True); + Scan_ALI (Lib_File, Text, Err => True); Free (Text); -- If no error was produced while loading this ALI file, diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 5cb2df0..90d8af4 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -125,7 +125,6 @@ procedure Gnatbind is Scan_ALI (F => Std_Lib_File, T => Text, - Ignore_ED => False, Err => False, Ignore_Errors => Debug_Flag_I); @@ -770,7 +769,6 @@ begin Id := Scan_ALI (F => Main_Lib_File, T => Text, - Ignore_ED => False, Err => False, Ignore_Errors => Debug_Flag_I, Directly_Scanned => True); diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 52e714a..a321bf3 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -1531,7 +1531,6 @@ begin A := Scan_ALI (F, T, - Ignore_ED => False, Err => False, Ignore_Errors => True); diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 353e36d6..c676996 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -2278,7 +2278,6 @@ begin Scan_ALI (Ali_File, Text, - Ignore_ED => False, Err => False, Ignore_Errors => True); end; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 6e74e90..10276fa 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1168,7 +1168,7 @@ package body Make is end if; else - ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True); + ALI := Scan_ALI (Lib_File, Text, Err => True); Free (Text); if ALI = No_ALI_Id then @@ -2647,7 +2647,7 @@ package body Make is if Text /= null then ALI := Scan_ALI - (Data.Lib_File, Text, Ignore_ED => False, Err => True); + (Data.Lib_File, Text, Err => True); if ALI = No_ALI_Id then diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 3786d2c..3ccd630 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1031,22 +1031,6 @@ package Opt is -- GNATBIND -- Set to True to enable XDR in s-stratt.adb. Set by -xdr. - type Create_Repinfo_File_Proc is access procedure (Src : String); - type Write_Repinfo_Line_Proc is access procedure (Info : String); - type Close_Repinfo_File_Proc is access procedure; - -- Types used for procedure addresses below - - Create_Repinfo_File_Access : Create_Repinfo_File_Proc := null; - Write_Repinfo_Line_Access : Write_Repinfo_Line_Proc := null; - Close_Repinfo_File_Access : Close_Repinfo_File_Proc := null; - -- GNAT - -- These three locations are left null when operating in non-compiler (e.g. - -- ASIS mode), but when operating in compiler mode, they are set to point - -- to the three corresponding procedures in Osint-C. The reason for this - -- slightly strange interface is to stop Repinfo from dragging in Osint in - -- ASIS mode, which would include lots of unwanted units in the ASIS build. - -- ??? Revisit this now that ASIS mode is gone. - type Create_List_File_Proc is access procedure (S : String); type Write_List_Info_Proc is access procedure (S : String); type Close_List_File_Proc is access procedure; diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index 14c6993..d08b082 100644 --- a/gcc/ada/osint-c.adb +++ b/gcc/ada/osint-c.adb @@ -520,10 +520,6 @@ package body Osint.C is begin Adjust_OS_Resource_Limits; - Opt.Create_Repinfo_File_Access := Create_Repinfo_File'Access; - Opt.Write_Repinfo_Line_Access := Write_Repinfo_Line'Access; - Opt.Close_Repinfo_File_Access := Close_Repinfo_File'Access; - Opt.Create_List_File_Access := Create_List_File'Access; Opt.Write_List_Info_Access := Write_List_Info'Access; Opt.Close_List_File_Access := Close_List_File'Access; diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 4ee6aa8..cf39128 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -2373,14 +2373,12 @@ package body Osint is Nb_Relative_Dir := 0; for J in 1 .. Len loop - -- Treat any control character as a path separator. Note that we do + -- Treat any EOL character as a path separator. Note that we do -- not treat space as a path separator (we used to treat space as a -- path separator in an earlier version). That way space can appear -- as a legitimate character in a path name. - -- Why do we treat all control characters as path separators??? - - if S (J) in ASCII.NUL .. ASCII.US then + if S (J) = ASCII.LF or else S (J) = ASCII.CR then S (J) := Path_Separator; end if; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 513275a..9720e47 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -216,9 +216,6 @@ package body Par_SCO is -- Parameter D, when present, indicates the dominant of the first -- declaration or statement within N. - -- Why is Traverse_Sync_Definition commented specifically, whereas - -- the others are not??? - procedure Traverse_Generic_Package_Declaration (N : Node_Id); procedure Traverse_Handled_Statement_Sequence @@ -235,8 +232,7 @@ package body Par_SCO is (N : Node_Id; D : Dominant_Info := No_Dominant); - procedure Traverse_Sync_Definition (N : Node_Id); - -- Traverse a protected definition or task definition + procedure Traverse_Protected_Or_Task_Definition (N : Node_Id); -- Note regarding traversals: In a few cases where an Alternatives list is -- involved, pragmas such as "pragma Page" may show up before the first @@ -690,9 +686,6 @@ package body Par_SCO is -- fully equivalent to the "To" sloc computed by -- Sloc_Range (Guard, To, From). - -- Doesn't this requirement of using First_Sloc need to be - -- documented in the spec ??? - if Nkind (Parent (N)) in N_Accept_Alternative | N_Delay_Alternative | N_Terminate_Alternative @@ -2331,7 +2324,7 @@ package body Par_SCO is Process_Decisions_Defer (Discriminant_Specifications (N), 'X'); Set_Statement_Entry; - Traverse_Sync_Definition (N); + Traverse_Protected_Or_Task_Definition (N); when N_Single_Protected_Declaration | N_Single_Task_Declaration @@ -2339,7 +2332,7 @@ package body Par_SCO is Extend_Statement_Sequence (N, 'o'); Set_Statement_Entry; - Traverse_Sync_Definition (N); + Traverse_Protected_Or_Task_Definition (N); when others => @@ -2517,11 +2510,11 @@ package body Par_SCO is Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom); end Traverse_Package_Declaration; - ------------------------------ - -- Traverse_Sync_Definition -- - ------------------------------ + ------------------------------------------- + -- Traverse_Protected_Or_Task_Definition -- + ------------------------------------------- - procedure Traverse_Sync_Definition (N : Node_Id) is + procedure Traverse_Protected_Or_Task_Definition (N : Node_Id) is Dom_Info : Dominant_Info := ('S', N); -- The first declaration is dominated by the protected or task [type] -- declaration. @@ -2570,7 +2563,7 @@ package body Par_SCO is Traverse_Declarations_Or_Statements (L => Priv_Decl, D => Dom_Info); - end Traverse_Sync_Definition; + end Traverse_Protected_Or_Task_Definition; -------------------------------------- -- Traverse_Subprogram_Or_Task_Body -- diff --git a/gcc/ada/pprint.adb b/gcc/ada/pprint.adb index f7717bf..b76bd91 100644 --- a/gcc/ada/pprint.adb +++ b/gcc/ada/pprint.adb @@ -100,7 +100,7 @@ package body Pprint is Add_Space : Boolean := True; Add_Paren : Boolean := True; Num : Natural := 1) return String; - -- ??? what does this do + -- Created for purposes of recursing on embedded lists ------------------------ -- Internal_List_Name -- @@ -113,30 +113,6 @@ package body Pprint is Add_Paren : Boolean := True; Num : Natural := 1) return String is - function Prepend (S : String) return String; - -- ??? what does this do - - ------------- - -- Prepend -- - ------------- - - function Prepend (S : String) return String is - begin - if Add_Space then - if Add_Paren then - return " (" & S; - else - return ' ' & S; - end if; - elsif Add_Paren then - return '(' & S; - else - return S; - end if; - end Prepend; - - -- Start of processing for Internal_List_Name - begin if not Present (List) then if First or else not Add_Paren then @@ -152,23 +128,22 @@ package body Pprint is end if; end if; - -- ??? the Internal_List_Name calls can be factored out - - if First then - return Prepend (Expr_Name (List) - & Internal_List_Name - (List => Next (List), - First => False, - Add_Paren => Add_Paren, - Num => Num + 1)); - else - return ", " & Expr_Name (List) - & Internal_List_Name - (List => Next (List), - First => False, - Add_Paren => Add_Paren, - Num => Num + 1); - end if; + -- Continue recursing on the list - handling the first element + -- in a special way. + + return + (if First then + (if Add_Space and Add_Paren then " (" + elsif Add_Paren then "(" + elsif Add_Space then " " + else "") + else ", ") + & Expr_Name (List) + & Internal_List_Name + (List => Next (List), + First => False, + Add_Paren => Add_Paren, + Num => Num + 1); end Internal_List_Name; -- Start of processing for List_Name diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 58e0161..084ca91 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -35,6 +35,7 @@ with Namet; use Namet; with Nlists; use Nlists; with Opt; use Opt; with Output; use Output; +with Osint.C; use Osint.C; with Sem_Aux; use Sem_Aux; with Sem_Eval; use Sem_Eval; with Sinfo; use Sinfo; @@ -1724,7 +1725,7 @@ package body Repinfo is -- List representation information to file else - Create_Repinfo_File_Access.all + Create_Repinfo_File (Get_Name_String (File_Name (Source_Index (U)))); Set_Special_Output (Write_Info_Line'Access); if List_Representation_Info_To_JSON then @@ -1736,7 +1737,7 @@ package body Repinfo is Write_Line ("]"); end if; Cancel_Special_Output; - Close_Repinfo_File_Access.all; + Close_Repinfo_File; end if; end if; end loop; @@ -2328,7 +2329,7 @@ package body Repinfo is procedure Write_Info_Line (S : String) is begin - Write_Repinfo_Line_Access.all (S (S'First .. S'Last - 1)); + Write_Repinfo_Line (S (S'First .. S'Last - 1)); end Write_Info_Line; --------------------- diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index bf1307c..fb42e30b 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -1743,13 +1743,13 @@ package body Scng is Code := Character'Pos (' '); -- In Ada 95 mode we allow any wide character in a character - -- literal, but in Ada 2005, the set of characters allowed - -- is restricted to graphic characters. + -- literal, but in later versions, the set of characters + -- allowed is restricted to graphic characters. elsif Ada_Version >= Ada_2005 and then Is_UTF_32_Non_Graphic (UTF_32 (Code)) then - Error_Msg -- CODEFIX???? + Error_Msg -- CODEFIX ("(Ada 2005) non-graphic character not permitted " & "in character literal", Wptr); end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index b44bbe3..f631e94 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1519,14 +1519,6 @@ package body Sem_Attr is Check_E1; Set_Etype (N, Str_Typ); - -- ???It's not clear why 'Img should behave any differently than - -- 'Image. - - if Attr_Id = Attribute_Img then - Error_Attr_P - ("prefix of % attribute must be a scalar object name"); - end if; - pragma Assert (Is_Entity_Name (P) and then Is_Type (Entity (P))); if Ekind (Entity (P)) = E_Incomplete_Type diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index f885d30..ea6ecf9 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -9480,13 +9480,12 @@ package body Sem_Ch6 is end if; -- Here if type is not frozen yet. It is illegal to have a primitive - -- equality declared in the private part if the type is visible. + -- equality declared in the private part if the type is visible + -- (RM 4.5.2(9.8)). elsif not In_Same_List (Parent (Typ), Decl) and then not Is_Limited_Type (Typ) then - -- Shouldn't we give an RM reference here??? - if Ada_Version >= Ada_2012 then Error_Msg_N ("equality operator appears too late<<", Eq_Op); @@ -9817,7 +9816,8 @@ package body Sem_Ch6 is -- conform when they do not, e.g. by converting 1+2 into 3. function FCE (Given_E1 : Node_Id; Given_E2 : Node_Id) return Boolean; - -- ??? + -- Convenience function to abbreviate recursive calls to + -- Fully_Conformant_Expressions without having to pass Report. function FCL (L1 : List_Id; L2 : List_Id) return Boolean; -- Compare elements of two lists for conformance. Elements have to be @@ -10778,7 +10778,7 @@ package body Sem_Ch6 is Error_Msg_Node_2 := F_Typ; Error_Msg_NE ("private operation& in generic unit does not override " - & "any primitive operation of& (RM 12.3 (18))??", + & "any primitive operation of& (RM 12.3(18))??", New_E, New_E); end if; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 396f616..825741a 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1403,7 +1403,9 @@ package body Sem_Type is and then Nkind (Unit_Declaration_Node (S)) = N_Subprogram_Renaming_Declaration - -- Why the Comes_From_Source test here??? + -- Determine if the renaming came from source or was generated as a + -- a result of generic expansion since the actual is represented by + -- a constructed subprogram renaming. and then not Comes_From_Source (Unit_Declaration_Node (S)) @@ -1460,7 +1462,8 @@ package body Sem_Type is then return True; - -- ??? There are possibly other cases to consider + -- Formal_Typ is a private view, or Opnd_Typ and Formal_Typ are + -- compatible only on a base-type basis. else return False; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 45a338a..c16a4b8 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -16264,12 +16264,14 @@ package body Sem_Util is Names_Match (Assign_Indexed_1, Assign_Indexed_2); end; + -- Checking for this aspect is performed elsewhere during freezing + when Aspect_No_Controlled_Parts => + return True; + -- scalar-valued aspects; compare (static) values. - when Aspect_Max_Entry_Queue_Length -- | Aspect_No_Controlled_Parts - => - -- This should be unreachable. No_Controlled_Parts is - -- not yet supported at all in GNAT and Max_Entry_Queue_Length - -- is supported only for protected entries, not for types. + when Aspect_Max_Entry_Queue_Length => + -- This should be unreachable. Max_Entry_Queue_Length is + -- supported only for protected entries, not for types. pragma Assert (Serious_Errors_Detected /= 0); return True; |