From 00332244ee74e60f4d7a54db20839c3a35b07588 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 5 Aug 2011 15:56:17 +0200 Subject: [PATCH] [multiple changes] 2011-08-05 Arnaud Charlet * make.adb (Linking_Phase): No longer need to set source search path before calling gnatlink in CodePeer mode. * gnatlink.adb (Gnatlink): No longer pass -gnat83/95/05/12 switch to gcc in CodePeer mode, since the binder generated file no longer has a 'with Main'. * switch.ads, switch.adb (Is_Language_Switch): Removed. * switch-c.adb: Update comment. 2011-08-05 Thomas Quinot * exp_strm.adb, bindgen.adb, s-ficobl.ads: Minor reformatting. 2011-08-05 Nicolas Roche * gnat_ugn.texi: Fix minor syntax error issue. 2011-08-05 Vincent Celier * gnatcmd.adb (Get_Closure): Do not crash when it is not possible to delete or close the file when the call to gnatmake returns a non successful return code. 2011-08-05 Ed Schonberg * exp_ch4.adb (Expand_N_Type_Conversion): When expanding a predicate check, indicate that the copy of the original node does not come from source, to prevent an infinite recursion of the expansion. 2011-08-05 Johannes Kanig * debug.adb: document switch -gnatd.G for gnat2why, which deactivates VC generation for subprogram bodies. 2011-08-05 Yannick Moy * einfo.ads: Typo. * sem_ch3.adb (Signed_Integer_Type_Declaration): in ALFA mode, define the base type with the smallest allowed base type. 2011-08-05 Sergey Rybin * tree_gen.adb, tree_in.adb, aspects.adb: Fix tree read-write for aspects. 2011-08-05 Ed Schonberg * sem_ch12.ads: minor comment updates. 2011-08-05 Ed Schonberg * sem_ch12.adb (Analyze_Formal_Package_Declaration): in an instantiation and a formal package the compiler generates a package renaming declaration so that the generic name within the declaration is interpreted as a renaming of the instance. At the end of a formal package declaration, this renaming must become invisible. From-SVN: r177437 --- gcc/ada/ChangeLog | 58 +++++++++++++++++++++++++++++++++ gcc/ada/aspects.adb | 27 +++++++++++++++- gcc/ada/bindgen.adb | 1 + gcc/ada/debug.adb | 6 +++- gcc/ada/einfo.ads | 2 +- gcc/ada/exp_ch4.adb | 12 +++++-- gcc/ada/exp_strm.adb | 22 ++++++------- gcc/ada/gnat_ugn.texi | 4 +-- gcc/ada/gnatcmd.adb | 17 +++++++--- gcc/ada/gnatlink.adb | 7 +--- gcc/ada/make.adb | 5 ++- gcc/ada/s-ficobl.ads | 4 +-- gcc/ada/sem_ch12.adb | 41 +++++++++++++---------- gcc/ada/sem_ch12.ads | 10 ++++-- gcc/ada/sem_ch3.adb | 75 +++++++++++++++++++++++++++++++++++++++++++ gcc/ada/switch-c.adb | 4 +-- gcc/ada/switch.adb | 17 ---------- gcc/ada/switch.ads | 4 --- gcc/ada/tree_gen.adb | 13 +++----- gcc/ada/tree_in.adb | 13 +++----- 20 files changed, 247 insertions(+), 95 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a1ba74ccab5..13f0ada39ac 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,61 @@ +2011-08-05 Arnaud Charlet + + * make.adb (Linking_Phase): No longer need to set source search path + before calling gnatlink in CodePeer mode. + * gnatlink.adb (Gnatlink): No longer pass -gnat83/95/05/12 switch to + gcc in CodePeer mode, since the binder generated file no longer has a + 'with Main'. + * switch.ads, switch.adb (Is_Language_Switch): Removed. + * switch-c.adb: Update comment. + +2011-08-05 Thomas Quinot + + * exp_strm.adb, bindgen.adb, s-ficobl.ads: Minor reformatting. + +2011-08-05 Nicolas Roche + + * gnat_ugn.texi: Fix minor syntax error issue. + +2011-08-05 Vincent Celier + + * gnatcmd.adb (Get_Closure): Do not crash when it is not possible to + delete or close the file when the call to gnatmake returns a non + successful return code. + +2011-08-05 Ed Schonberg + + * exp_ch4.adb (Expand_N_Type_Conversion): When expanding a predicate + check, indicate that the copy of the original node does not come from + source, to prevent an infinite recursion of the expansion. + +2011-08-05 Johannes Kanig + + * debug.adb: document switch -gnatd.G for gnat2why, which deactivates + VC generation for subprogram bodies. + +2011-08-05 Yannick Moy + + * einfo.ads: Typo. + * sem_ch3.adb (Signed_Integer_Type_Declaration): in ALFA mode, define + the base type with the smallest allowed base type. + +2011-08-05 Sergey Rybin + + * tree_gen.adb, tree_in.adb, aspects.adb: Fix tree read-write for + aspects. + +2011-08-05 Ed Schonberg + + * sem_ch12.ads: minor comment updates. + +2011-08-05 Ed Schonberg + + * sem_ch12.adb (Analyze_Formal_Package_Declaration): in an + instantiation and a formal package the compiler generates a package + renaming declaration so that the generic name within the declaration + is interpreted as a renaming of the instance. At the end of a formal + package declaration, this renaming must become invisible. + 2011-08-05 Hristian Kirtchev * exp_ch7.adb (Is_Init_Call): Reimplemented to avoid character diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 82649db56ab..7bb9724fb5c 100755 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -38,6 +38,17 @@ with GNAT.HTable; use GNAT.HTable; package body Aspects is + procedure Set_Aspect_Specifications_No_Check (N : Node_Id; L : List_Id); + -- Same as Set_Aspect_Specifications, but does not contain the assertion + -- that checks that N does not already have aspect specifications. This + -- subprogram is supposed to be used as a part of Tree_Read. When reading + -- the tree we first read nodes with their basic properties (as + -- Atree.Tree_Read), this includes reading the Has_Aspects flag for each + -- node, then we reed all the list tables and only after that we call + -- Tree_Read for Aspects. That is, when reading the tree, the list of + -- aspects is attached to the node that already has Has_Aspects flag set + -- ON + ------------------------------------------ -- Hash Table for Aspect Specifications -- ------------------------------------------ @@ -261,6 +272,20 @@ package body Aspects is Aspect_Specifications_Hash_Table.Set (N, L); end Set_Aspect_Specifications; + ---------------------------------------- + -- Set_Aspect_Specifications_No_Check -- + ---------------------------------------- + + procedure Set_Aspect_Specifications_No_Check (N : Node_Id; L : List_Id) is + begin + pragma Assert (Permits_Aspect_Specifications (N)); + pragma Assert (L /= No_List); + + Set_Has_Aspects (N); + Set_Parent (L, N); + Aspect_Specifications_Hash_Table.Set (N, L); + end Set_Aspect_Specifications_No_Check; + --------------- -- Tree_Read -- --------------- @@ -273,7 +298,7 @@ package body Aspects is Tree_Read_Int (Int (Node)); Tree_Read_Int (Int (List)); exit when List = No_List; - Set_Aspect_Specifications (Node, List); + Set_Aspect_Specifications_No_Check (Node, List); end loop; end Tree_Read; diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 856a4de1a6c..24e58cc45fb 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -1502,6 +1502,7 @@ package body Bindgen is WBI (""); -- For CodePeer, declare a wrapper for the user-defined main program + if CodePeer_Mode then Gen_CodePeer_Wrapper; end if; diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 329e687f06b..af6200dc836 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -124,7 +124,7 @@ package body Debug is -- d.D -- d.E -- d.F ALFA mode - -- d.G + -- d.G Precondition only mode for gnat2why -- d.H -- d.I SCIL generation mode -- d.J Disable parallel SCIL generation mode @@ -584,6 +584,10 @@ package body Debug is -- as well as additional cross reference information in ALI files to -- compute effects of subprograms. + -- d.G Precondition only mode for gnat2why. In this mode, gnat2why will + -- only generate Why code that checks for the well-guardedness of + -- preconditions. + -- d.I Generate SCIL mode. Generate intermediate code for the sake of -- of static analysis tools, and ensure additional tree consistency -- between different compilations of specs. diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 2b82567667e..35fce3adc27 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -131,7 +131,7 @@ package Einfo is -- The Ada 95 RM contains some rather peculiar (to us!) rules on the value -- of type'Size (see RM 13.3(55)). We have found that attempting to use -- these RM Size values generally, and in particular for determining the --- default size of objects, creates chaos, and major incompatibilies in +-- default size of objects, creates chaos, and major incompatibilities in -- existing code. -- We proceed as follows, for discrete and fixed-point subtypes, we have diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 9acc3e4fa8c..9ec558cca2a 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -9154,8 +9154,16 @@ package body Exp_Ch4 is and then Target_Type /= Operand_Type and then Comes_From_Source (N) then - Insert_Action (N, - Make_Predicate_Check (Target_Type, Duplicate_Subexpr (N))); + declare + New_Expr : constant Node_Id := Duplicate_Subexpr (N); + + begin + -- Avoid infinite recursion on the subsequent expansion of + -- of the copy of the original type conversion. + + Set_Comes_From_Source (New_Expr, False); + Insert_Action (N, Make_Predicate_Check (Target_Type, New_Expr)); + end; end if; end Expand_N_Type_Conversion; diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index 35fcb640529..985f8656c66 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -911,10 +911,10 @@ package body Exp_Strm is Selector_Name => Make_Identifier (Loc, Name_V)); -- Generate Reads for the discriminants of the type. The discriminants - -- need to be read before the rest of the components, so that - -- variants are initialized correctly. The discriminants must be read - -- into temporary variables so an incomplete Read (interrupted by an - -- exception, for example) does not alter the passed object. + -- need to be read before the rest of the components, so that variants + -- are initialized correctly. The discriminants must be read into temp + -- variables so an incomplete Read (interrupted by an exception, for + -- example) does not alter the passed object. while Present (Disc) loop Tmp_For_Disc := Make_Defining_Identifier (Loc, @@ -928,9 +928,9 @@ package body Exp_Strm is Append_To (Stms, Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Etype (Disc), Loc), + Prefix => New_Occurrence_Of (Etype (Disc), Loc), Attribute_Name => Name_Read, - Expressions => New_List ( + Expressions => New_List ( Make_Identifier (Loc, Name_S), New_Occurrence_Of (Tmp_For_Disc, Loc)))); @@ -946,14 +946,14 @@ package body Exp_Strm is Left_Opnd => New_Occurrence_Of (Tmp_For_Disc, Loc), Right_Opnd => Make_Selected_Component (Loc, - Prefix => New_Copy_Tree (Out_Formal), + Prefix => New_Copy_Tree (Out_Formal), Selector_Name => New_Occurrence_Of (Disc, Loc))), Reason => CE_Discriminant_Check_Failed)); Next_Discriminant (Disc); end loop; - -- Generate reads for the components of the record (including - -- those that depend on discriminants). + -- Generate reads for the components of the record (including those + -- that depend on discriminants). Build_Record_Read_Write_Procedure (Loc, Typ, Decl, Pnam, Name_Read); @@ -977,14 +977,14 @@ package body Exp_Strm is Constrained_Stms := Statements (Handled_Statement_Sequence (Decl)); Append_To (Stms, Make_Block_Statement (Loc, - Declarations => Dcls, + Declarations => Dcls, Handled_Statement_Sequence => Parent (Constrained_Stms))); Append_To (Constrained_Stms, Make_Implicit_If_Statement (Pnam, Condition => Make_Attribute_Reference (Loc, - Prefix => New_Copy_Tree (Out_Formal), + Prefix => New_Copy_Tree (Out_Formal), Attribute_Name => Name_Constrained), Then_Statements => Discriminant_Checks)); diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 2dedf85bd99..26f3085653b 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -14535,10 +14535,10 @@ Gnatmetric computes the following coupling metrics: sense; @item -emph{unit coupling} - for all the program units making up a program; +@emph{unit coupling} - for all the program units making up a program; @item -emph{control coupling} - this metric counts dependencies between a unit and +@emph{control coupling} - this metric counts dependencies between a unit and only those units that define subprograms; @end itemize diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 1a25dc8347f..28bccf0db10 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -865,11 +865,18 @@ procedure GNATCmd is if Return_Code /= 0 then Get_Line (File, Line, Last); - if not Keep_Temporary_Files then - Delete (File); - else - Close (File); - end if; + begin + if not Keep_Temporary_Files then + Delete (File); + else + Close (File); + end if; + + exception + -- Don't crash if it is not possible to delete or close the file + when others => + null; + end; Put_Line (Standard_Error, Line (1 .. Last)); Put_Line diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 9c340fbfd42..5afe2be6306 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -1572,16 +1572,11 @@ begin -- is to be dealt with specially because it needs to be passed -- if the binder-generated file is in Ada and may also be used -- to drive the linker. - -- Also in CodePeer mode, we need to pass the -gnat05 or - -- -gnat12 switches to be able to compile the binder file. declare Arg : String_Ptr renames Args.Table (Index); begin - if not Is_Front_End_Switch (Arg.all) - or else (Opt.CodePeer_Mode - and then Is_Language_Switch (Arg.all)) - then + if not Is_Front_End_Switch (Arg.all) then Binder_Options_From_ALI.Increment_Last; Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := String_Access (Arg); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index a725b9ab75d..4cc0365b410 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -4352,14 +4352,13 @@ package body Make is end if; end if; - -- Put the object directories in ADA_OBJECTS_PATH. Same treatment for - -- source directories in ADA_INCLUDE_PATH if in CodePeer mode. + -- Put the object directories in ADA_OBJECTS_PATH. Prj.Env.Set_Ada_Paths (Main_Project, Project_Tree, Including_Libraries => False, - Include_Path => CodePeer_Mode); + Include_Path => False); -- Check for attributes Linker'Linker_Options in projects other than -- the main project diff --git a/gcc/ada/s-ficobl.ads b/gcc/ada/s-ficobl.ads index c8f6bc66207..0f7dbad6ff3 100644 --- a/gcc/ada/s-ficobl.ads +++ b/gcc/ada/s-ficobl.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -122,7 +122,7 @@ package System.File_Control_Block is -- Indicates sharing status of file, see description of type above Access_Method : Character; - -- Set to 'Q', 'S', 'T, 'D' for Sequential_IO, Stream_IO, Text_IO + -- Set to 'Q', 'S', 'T, 'D' for Sequential_IO, Stream_IO, Text_IO, -- Direct_IO file (used to validate file sharing request). Next : AFCB_Ptr; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index c3d558928ea..db1f2e707b5 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -2015,7 +2015,7 @@ package body Sem_Ch12 is Renaming : Node_Id; Parent_Instance : Entity_Id; Renaming_In_Par : Entity_Id; - No_Associations : Boolean := False; + Associations : Boolean := True; function Build_Local_Package return Node_Id; -- The formal package is rewritten so that its parameters are replaced @@ -2186,7 +2186,7 @@ package body Sem_Ch12 is or else No (Generic_Associations (N)) or else Nkind (First (Generic_Associations (N))) = N_Others_Choice then - No_Associations := True; + Associations := False; end if; -- If there are no generic associations, the generic parameters appear @@ -2266,25 +2266,32 @@ package body Sem_Ch12 is -- The formals for which associations are provided are not visible -- outside of the formal package. The others are still declared by a -- formal parameter declaration. + -- If there are no associations, the only local entity to hide is the + -- generated package renaming itself. - if not No_Associations then - declare - E : Entity_Id; + declare + E : Entity_Id; - begin - E := First_Entity (Formal); - while Present (E) loop - exit when Ekind (E) = E_Package - and then Renamed_Entity (E) = Formal; + begin + E := First_Entity (Formal); + while Present (E) loop - if not Is_Generic_Formal (E) then - Set_Is_Hidden (E); - end if; + if Associations + and then not Is_Generic_Formal (E) + then + Set_Is_Hidden (E); + end if; - Next_Entity (E); - end loop; - end; - end if; + if Ekind (E) = E_Package + and then Renamed_Entity (E) = Formal + then + Set_Is_Hidden (E); + exit; + end if; + + Next_Entity (E); + end loop; + end; End_Package_Scope (Formal); diff --git a/gcc/ada/sem_ch12.ads b/gcc/ada/sem_ch12.ads index 676be37e31f..3fe88c96ae7 100644 --- a/gcc/ada/sem_ch12.ads +++ b/gcc/ada/sem_ch12.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -151,10 +151,14 @@ package Sem_Ch12 is procedure Save_Env (Gen_Unit : Entity_Id; Act_Unit : Entity_Id); - -- ??? comment needed + -- Because instantiations can be nested, the compiler maintains a stack + -- of environments that holds variables relevant to the current instance: + -- most importanty Instantiated_Parent, Exchanged_Views, Hidden_Entities, + -- and others (see full list in Instance_Env). procedure Restore_Env; - -- ??? comment needed + -- After processing an instantiation, or aborting one because of semantic + -- errors, remove the current Instantiation_Env from Instantation_Envs. procedure Initialize; -- Initializes internal data structures diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index fad454e5ec3..653d9dfa328 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -19678,6 +19678,81 @@ package body Sem_Ch3 is Set_Ekind (T, E_Signed_Integer_Subtype); Set_Etype (T, Implicit_Base); + -- In formal verification mode, override partially the decisions above + -- to restrict base type's range to the minimum allowed by RM 3.5.4, + -- namely the smallest symmetric range around zero with a possible extra + -- negative value that contains the subtype range. Keep Size, RM_Size + -- and First_Rep_Item info, which should not be relied upon in formal + -- verification. + + if ALFA_Mode then + + -- If the range of the type is already symmetric with a possible + -- extra negative value, just make the type its own base type. + + if UI_Le (Lo_Val, Hi_Val) + and then (UI_Eq (Lo_Val, UI_Negate (Hi_Val)) + or else + UI_Eq (Lo_Val, UI_Sub (UI_Negate (Hi_Val), Uint_1))) + then + Set_Etype (T, T); + + else + declare + Sym_Hi_Val : Uint; + Sym_Lo_Val : Uint; + Decl : Node_Id; + Dloc : constant Source_Ptr := Sloc (Def); + Lbound : Node_Id; + Ubound : Node_Id; + + begin + -- If the subtype range is empty, the smallest base type range + -- is the symmetric range around zero containing Lo_Val and + -- Hi_Val. + + if UI_Gt (Lo_Val, Hi_Val) then + Sym_Hi_Val := UI_Max (UI_Abs (Lo_Val), UI_Abs (Hi_Val)); + Sym_Lo_Val := UI_Negate (Sym_Hi_Val); + + -- Otherwise, if the subtype range is not empty and Hi_Val has + -- the largest absolute value, Hi_Val is non negative and the + -- smallest base type range is the symmetric range around zero + -- containing Hi_Val. + + elsif UI_Le (UI_Abs (Lo_Val), UI_Abs (Hi_Val)) then + Sym_Hi_Val := Hi_Val; + Sym_Lo_Val := UI_Negate (Hi_Val); + + -- Otherwise, the subtype range is not empty, Lo_Val has the + -- strictly largest absolute value, Lo_Val is negative and the + -- smallest base type range is the symmetric range around zero + -- with an extra negative value Lo_Val. + + else + Sym_Lo_Val := Lo_Val; + Sym_Hi_Val := UI_Sub (UI_Negate (Lo_Val), Uint_1); + end if; + + Lbound := Make_Integer_Literal (Dloc, Sym_Lo_Val); + Ubound := Make_Integer_Literal (Dloc, Sym_Hi_Val); + Set_Is_Static_Expression (Lbound); + Set_Is_Static_Expression (Ubound); + + Decl := Make_Full_Type_Declaration (Dloc, + Defining_Identifier => Implicit_Base, + Type_Definition => + Make_Signed_Integer_Type_Definition (Dloc, + Low_Bound => Lbound, + High_Bound => Ubound)); + + Analyze (Decl); + Set_Etype (Implicit_Base, Implicit_Base); + Insert_Before (Parent (Def), Decl); + end; + end if; + end if; + Set_Size_Info (T, (Implicit_Base)); Set_First_Rep_Item (T, First_Rep_Item (Implicit_Base)); Set_Scalar_Range (T, Def); diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index b0be8908b90..c4189f58796 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -1059,8 +1059,8 @@ package body Switch.C is ("-gnatZ is no longer supported: consider using --RTS=zcx"); -- Note on language version switches: whenever a new language - -- version switch is added, function Switch.Is_Language_Switch and - -- procedure Switch.M.Normalize_Compiler_Switches must be updated. + -- version switch is added, procedure + -- Switch.M.Normalize_Compiler_Switches must be updated. -- Processing for 83 switch diff --git a/gcc/ada/switch.adb b/gcc/ada/switch.adb index e2987060858..000f95136c5 100644 --- a/gcc/ada/switch.adb +++ b/gcc/ada/switch.adb @@ -138,23 +138,6 @@ package body Switch is and then Switch_Chars (Ptr + 2 .. Ptr + 4) = "RTS")); end Is_Front_End_Switch; - ------------------------- - -- Is_Language_Switch -- - ------------------------- - - function Is_Language_Switch (Switch_Chars : String) return Boolean is - Ptr : constant Positive := Switch_Chars'First; - begin - return Is_Switch (Switch_Chars) - and then - (Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat83" - or else Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat95" - or else Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat05" - or else Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat2005" - or else Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat12" - or else Switch_Chars (Ptr + 1 .. Switch_Chars'Last) = "gnat2012"); - end Is_Language_Switch; - ---------------------------- -- Is_Internal_GCC_Switch -- ---------------------------- diff --git a/gcc/ada/switch.ads b/gcc/ada/switch.ads index d7afa9aa44a..ce3b37166eb 100644 --- a/gcc/ada/switch.ads +++ b/gcc/ada/switch.ads @@ -72,10 +72,6 @@ package Switch is -- Returns True iff Switch_Chars represents a front-end switch, i.e. it -- starts with -I, -gnat or -?RTS. - function Is_Language_Switch (Switch_Chars : String) return Boolean; - -- Returns True iff Switch_Chars represents a language switch, i.e. it - -- specifies -gnat83/95/2005/2012. - function Is_Internal_GCC_Switch (Switch_Chars : String) return Boolean; -- Returns True iff Switch_Chars represents an internal GCC switch to be -- followed by a single argument, such as -dumpbase, --param or -auxbase. diff --git a/gcc/ada/tree_gen.adb b/gcc/ada/tree_gen.adb index 67f588d2bad..c289443d696 100644 --- a/gcc/ada/tree_gen.adb +++ b/gcc/ada/tree_gen.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -25,7 +25,6 @@ with Aspects; with Atree; -with Debug; with Elists; with Fname; with Lib; @@ -51,14 +50,8 @@ procedure Tree_Gen is begin if Opt.Tree_Output then Osint.C.Tree_Create; - Opt.Tree_Write; - - -- For now, only write aspect specifications hash table if -gnatd.A set - - if Debug.Debug_Flag_Dot_AA then - Aspects.Tree_Write; - end if; + Opt.Tree_Write; Atree.Tree_Write; Elists.Tree_Write; Fname.Tree_Write; @@ -72,6 +65,8 @@ begin Uintp.Tree_Write; Urealp.Tree_Write; Repinfo.Tree_Write; + Aspects.Tree_Write; + Osint.C.Tree_Close; end if; end Tree_Gen; diff --git a/gcc/ada/tree_in.adb b/gcc/ada/tree_in.adb index 200c566fba9..fd09c63b950 100644 --- a/gcc/ada/tree_in.adb +++ b/gcc/ada/tree_in.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -32,7 +32,6 @@ with Aspects; with Atree; with Csets; -with Debug; with Elists; with Fname; with Lib; @@ -51,14 +50,8 @@ with Urealp; procedure Tree_In (Desc : File_Descriptor) is begin Tree_IO.Tree_Read_Initialize (Desc); - Opt.Tree_Read; - - -- For now, only read aspect specifications hash table if -gnatd.A is set - - if Debug.Debug_Flag_Dot_AA then - Aspects.Tree_Read; - end if; + Opt.Tree_Read; Atree.Tree_Read; Elists.Tree_Read; Fname.Tree_Read; @@ -72,5 +65,7 @@ begin Uintp.Tree_Read; Urealp.Tree_Read; Repinfo.Tree_Read; + Aspects.Tree_Read; + Csets.Initialize; end Tree_In; -- 2.30.2