From 0712790c364b9d0de4d023ebd22fa9249afc35d5 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 6 Jun 2007 12:28:07 +0200 Subject: [PATCH] exp_util.ads, [...] (Expand_Subtype_From_Expr): In Ada2005... 2007-04-20 Ed Schonberg * exp_util.ads, exp_util.adb (Expand_Subtype_From_Expr): In Ada2005, an object of a limited type can be initialized with a call to a function that returns in place. If the limited type has unknown discriminants, and the underlying type is a constrained composite type, build an actual subtype from the function call, as is done for private types. (Side_Effect_Free): An expression that is the renaming of an object or whose prefix is the renaming of a object, is not side-effect free because it may be assigned through the renaming and its value must be captured in a temporary. (Has_Controlled_Coextensions): New routine. (Expand_Subtype_From_Expr): Do nothing if type is a limited interface, as is done for other limited types. (Non_Limited_Designated_Type): new predicate. (Make_CW_Equivalent_Type): Modified to handle class-wide interface objects. Remove all handling of with_type clauses. * par-ch10.adb: Remove all handling of with_type clauses. * lib-load.ads, lib-load.adb (Load_Main_Source): Do not get the checksum if the main source could not be parsed. (Loat_Unit): When processing a child unit, determine properly whether the parent unit is a renaming when the parent is itself a child unit. Remove handling of with_type clauses. * sinfo.ads, sinfo.adb (Is_Static_Coextension): New function. (Set_Is_Static_Coextension): New procedure. (Has_Local_Raise): New function (Set_Has_Local_Raise): New procedure (Renaming_Exception): New field (Has_Init_Expression): New flag (Delay_Finalize_Attach): Remove because flag is obsolete. (Set_Delay_Finalize_Attach): Remove because flag is obsolete. Remove all handling of with_type clauses. (Exception_Junk): Can now be set in N_Block_Statement From-SVN: r125410 --- gcc/ada/exp_util.adb | 292 +++++++++++++++++++++++++++++++++---------- gcc/ada/exp_util.ads | 22 +++- gcc/ada/lib-load.adb | 113 +++++++++++++---- gcc/ada/lib-load.ads | 11 +- gcc/ada/par-ch10.adb | 13 +- gcc/ada/sinfo.adb | 100 +++++++++++---- gcc/ada/sinfo.ads | 144 +++++++++++++-------- 7 files changed, 514 insertions(+), 181 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 5e938aa1fc8..93798b30eb2 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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,11 +32,9 @@ with Elists; use Elists; with Errout; use Errout; with Exp_Aggr; use Exp_Aggr; with Exp_Ch7; use Exp_Ch7; -with Hostparm; use Hostparm; with Inline; use Inline; with Itypes; use Itypes; with Lib; use Lib; -with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; @@ -653,7 +651,7 @@ package body Exp_Util is Expr := Make_Function_Call (Loc, Name => New_Occurrence_Of (Defining_Entity (Fun), Loc)); - if not In_Init_Proc then + if not In_Init_Proc and then VM_Target = No_VM then Set_Uses_Sec_Stack (Defining_Entity (Fun)); end if; end if; @@ -1289,11 +1287,35 @@ package body Exp_Util is then null; - -- Nothing to be done if the type of the expression is limited, because - -- in this case the expression cannot be copied, and its use can only - -- be by reference and there is no need for the actual subtype. + -- In Ada95, Nothing to be done if the type of the expression is + -- limited, because in this case the expression cannot be copied, + -- and its use can only be by reference. - elsif Is_Limited_Type (Exp_Typ) then + -- In Ada2005, the context can be an object declaration whose expression + -- is a function that returns in place. If the nominal subtype has + -- unknown discriminants, the call still provides constraints on the + -- object, and we have to create an actual subtype from it. + + -- If the type is class-wide, the expression is dynamically tagged and + -- we do not create an actual subtype either. Ditto for an interface. + + elsif Is_Limited_Type (Exp_Typ) + and then + (Is_Class_Wide_Type (Exp_Typ) + or else Is_Interface (Exp_Typ) + or else not Has_Unknown_Discriminants (Exp_Typ) + or else not Is_Composite_Type (Unc_Type)) + then + null; + + -- For limited interfaces, nothing to be done + + -- This branch may be redundant once the limited interface issue is + -- sorted out??? + + elsif Is_Interface (Exp_Typ) + and then Is_Limited_Interface (Exp_Typ) + then null; else @@ -2106,6 +2128,44 @@ package body Exp_Util is end; end Get_Current_Value_Condition; + --------------------------------- + -- Has_Controlled_Coextensions -- + --------------------------------- + + function Has_Controlled_Coextensions (Typ : Entity_Id) return Boolean is + D_Typ : Entity_Id; + Discr : Entity_Id; + + begin + -- Only consider record types + + if Ekind (Typ) /= E_Record_Type + and then Ekind (Typ) /= E_Record_Subtype + then + return False; + end if; + + if Has_Discriminants (Typ) then + Discr := First_Discriminant (Typ); + while Present (Discr) loop + D_Typ := Etype (Discr); + + if Ekind (D_Typ) = E_Anonymous_Access_Type + and then + (Is_Controlled (Directly_Designated_Type (D_Typ)) + or else + Is_Concurrent_Type (Directly_Designated_Type (D_Typ))) + then + return True; + end if; + + Next_Discriminant (Discr); + end loop; + end if; + + return False; + end Has_Controlled_Coextensions; + -------------------- -- Homonym_Number -- -------------------- @@ -2725,8 +2785,7 @@ package body Exp_Util is N_Variant | N_Variant_Part | N_Validate_Unchecked_Conversion | - N_With_Clause | - N_With_Type_Clause + N_With_Clause => null; @@ -2755,13 +2814,14 @@ package body Exp_Util is P := Parent (N); end if; end loop; - end Insert_Actions; -- Version with check(s) suppressed procedure Insert_Actions - (Assoc_Node : Node_Id; Ins_Actions : List_Id; Suppress : Check_Id) + (Assoc_Node : Node_Id; + Ins_Actions : List_Id; + Suppress : Check_Id) is begin if Suppress = All_Checks then @@ -2810,7 +2870,8 @@ package body Exp_Util is Aux : constant Node_Id := Aux_Decls_Node (Cunit (Main_Unit)); begin - New_Scope (Cunit_Entity (Main_Unit)); + Push_Scope (Cunit_Entity (Main_Unit)); + -- ??? should this be Current_Sem_Unit instead of Main_Unit? if No (Actions (Aux)) then Set_Actions (Aux, New_List (N)); @@ -2831,7 +2892,8 @@ package body Exp_Util is begin if Is_Non_Empty_List (L) then - New_Scope (Cunit_Entity (Main_Unit)); + Push_Scope (Cunit_Entity (Main_Unit)); + -- ??? should this be Current_Sem_Unit instead of Main_Unit? if No (Actions (Aux)) then Set_Actions (Aux, L); @@ -3078,14 +3140,7 @@ package body Exp_Util is function Is_Possibly_Unaligned_Slice (N : Node_Id) return Boolean is begin - -- ??? GCC3 will eventually handle strings with arbitrary alignments, - -- but for now the following check must be disabled. - - -- if get_gcc_version >= 3 then - -- return False; - -- end if; - - -- For renaming case, go to renamed object + -- Go to renamed object if Is_Entity_Name (N) and then Is_Object (Entity (N)) @@ -3589,6 +3644,7 @@ package body Exp_Util is Loc : constant Source_Ptr := Sloc (E); Root_Typ : constant Entity_Id := Root_Type (T); List_Def : constant List_Id := Empty_List; + Comp_List : constant List_Id := New_List; Equiv_Type : Entity_Id; Range_Type : Entity_Id; Str_Type : Entity_Id; @@ -3611,22 +3667,35 @@ package body Exp_Util is Make_Subtype_From_Expr (E, Root_Typ))); end if; - -- subtype rg__xx is Storage_Offset range - -- (Expr'size - typ'size) / Storage_Unit + -- Generate the range subtype declaration Range_Type := Make_Defining_Identifier (Loc, New_Internal_Name ('G')); - Sizexpr := - Make_Op_Subtract (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => - OK_Convert_To (T, Duplicate_Subexpr_No_Checks (E)), - Attribute_Name => Name_Size), - Right_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Constr_Root, Loc), - Attribute_Name => Name_Object_Size)); + if not Is_Interface (Root_Typ) then + -- subtype rg__xx is + -- Storage_Offset range 1 .. (Expr'size - typ'size) / Storage_Unit + + Sizexpr := + Make_Op_Subtract (Loc, + Left_Opnd => + Make_Attribute_Reference (Loc, + Prefix => + OK_Convert_To (T, Duplicate_Subexpr_No_Checks (E)), + Attribute_Name => Name_Size), + Right_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (Constr_Root, Loc), + Attribute_Name => Name_Object_Size)); + else + -- subtype rg__xx is + -- Storage_Offset range 1 .. Expr'size / Storage_Unit + + Sizexpr := + Make_Attribute_Reference (Loc, + Prefix => + OK_Convert_To (T, Duplicate_Subexpr_No_Checks (E)), + Attribute_Name => Name_Size); + end if; Set_Paren_Count (Sizexpr, 1); @@ -3661,7 +3730,7 @@ package body Exp_Util is New_List (New_Reference_To (Range_Type, Loc)))))); -- type Equiv_T is record - -- _parent : Tnn; + -- [ _parent : Tnn; ] -- E : Str_Type; -- end Equiv_T; @@ -3682,36 +3751,41 @@ package body Exp_Util is Set_Ekind (Equiv_Type, E_Record_Type); Set_Parent_Subtype (Equiv_Type, Constr_Root); + if not Is_Interface (Root_Typ) then + Append_To (Comp_List, + Make_Component_Declaration (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, Name_uParent), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => New_Reference_To (Constr_Root, Loc)))); + end if; + + Append_To (Comp_List, + Make_Component_Declaration (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('C')), + Component_Definition => + Make_Component_Definition (Loc, + Aliased_Present => False, + Subtype_Indication => New_Reference_To (Str_Type, Loc)))); + Append_To (List_Def, Make_Full_Type_Declaration (Loc, Defining_Identifier => Equiv_Type, - Type_Definition => Make_Record_Definition (Loc, - Component_List => Make_Component_List (Loc, - Component_Items => New_List ( - Make_Component_Declaration (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, Name_uParent), - Component_Definition => - Make_Component_Definition (Loc, - Aliased_Present => False, - Subtype_Indication => - New_Reference_To (Constr_Root, Loc))), - - Make_Component_Declaration (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, - Chars => New_Internal_Name ('C')), - Component_Definition => - Make_Component_Definition (Loc, - Aliased_Present => False, - Subtype_Indication => - New_Reference_To (Str_Type, Loc)))), - - Variant_Part => Empty)))); - - Insert_Actions (E, List_Def); + Component_List => + Make_Component_List (Loc, + Component_Items => Comp_List, + Variant_Part => Empty)))); + + -- Suppress all checks during the analysis of the expanded code + -- to avoid the generation of spurious warnings under ZFP run-time. + + Insert_Actions (E, List_Def, Suppress => All_Checks); return Equiv_Type; end Make_CW_Equivalent_Type; @@ -3839,12 +3913,12 @@ package body Exp_Util is EQ_Typ : Entity_Id := Empty; begin - -- A class-wide equivalent type is not needed when Java_VM - -- because the JVM back end handles the class-wide object + -- A class-wide equivalent type is not needed when VM_Target + -- because the VM back-ends handle the class-wide object -- initialization itself (and doesn't need or want the -- additional intermediate type to handle the assignment). - if Expander_Active and then not Java_VM then + if Expander_Active and then VM_Target = No_VM then EQ_Typ := Make_CW_Equivalent_Type (Unc_Typ, E); end if; @@ -3952,6 +4026,22 @@ package body Exp_Util is return (Res); end New_Class_Wide_Subtype; + -------------------------------- + -- Non_Limited_Designated_Type -- + --------------------------------- + + function Non_Limited_Designated_Type (T : Entity_Id) return Entity_Id is + Desig : constant Entity_Id := Designated_Type (T); + begin + if Ekind (Desig) = E_Incomplete_Type + and then Present (Non_Limited_View (Desig)) + then + return Non_Limited_View (Desig); + else + return Desig; + end if; + end Non_Limited_Designated_Type; + ----------------------------------- -- OK_To_Do_Constant_Replacement -- ----------------------------------- @@ -4019,6 +4109,69 @@ package body Exp_Util is end if; end OK_To_Do_Constant_Replacement; + ------------------------------------ + -- Possible_Bit_Aligned_Component -- + ------------------------------------ + + function Possible_Bit_Aligned_Component (N : Node_Id) return Boolean is + begin + case Nkind (N) is + + -- Case of indexed component + + when N_Indexed_Component => + declare + P : constant Node_Id := Prefix (N); + Ptyp : constant Entity_Id := Etype (P); + + begin + -- If we know the component size and it is less than 64, then + -- we are definitely OK. The back end always does assignment + -- of misaligned small objects correctly. + + if Known_Static_Component_Size (Ptyp) + and then Component_Size (Ptyp) <= 64 + then + return False; + + -- Otherwise, we need to test the prefix, to see if we are + -- indexing from a possibly unaligned component. + + else + return Possible_Bit_Aligned_Component (P); + end if; + end; + + -- Case of selected component + + when N_Selected_Component => + declare + P : constant Node_Id := Prefix (N); + Comp : constant Entity_Id := Entity (Selector_Name (N)); + + begin + -- If there is no component clause, then we are in the clear + -- since the back end will never misalign a large component + -- unless it is forced to do so. In the clear means we need + -- only the recursive test on the prefix. + + if Component_May_Be_Bit_Aligned (Comp) then + return True; + else + return Possible_Bit_Aligned_Component (P); + end if; + end; + + -- If we have neither a record nor array component, it means that we + -- have fallen off the top testing prefixes recursively, and we now + -- have a stand alone object, where we don't have a problem. + + when others => + return False; + + end case; + end Possible_Bit_Aligned_Component; + ------------------------- -- Remove_Side_Effects -- ------------------------- @@ -4171,6 +4324,17 @@ package body Exp_Util is elsif Compile_Time_Known_Value (N) then return True; + + -- A variable renaming is not side-effet free, because the + -- renaming will function like a macro in the front-end in + -- some cases, and an assignment can modify the the component + -- designated by N, so we need to create a temporary for it. + + elsif Is_Entity_Name (Original_Node (N)) + and then Is_Renaming_Of_Object (Entity (Original_Node (N))) + and then Ekind (Entity (Original_Node (N))) /= E_Constant + then + return False; end if; -- For other than entity names and compile time known values, diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index dee5927b39d..ccf67401716 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -27,6 +27,7 @@ -- Package containing utility procedures used throughout the expander with Exp_Tss; use Exp_Tss; +with Namet; use Namet; with Rtsfind; use Rtsfind; with Sinfo; use Sinfo; with Types; use Types; @@ -393,7 +394,7 @@ package Exp_Util is -- or not known at all. In the first two cases, Get_Current_Condition will -- return with Op set to the appropriate conditional operator (inverted if -- the condition is known false), and Val set to the constant value. If the - -- condition is not known, then Cond and Val are set for the empty case + -- condition is not known, then Op and Val are set for the empty case -- (N_Empty and Empty). -- -- The check for whether the condition is true/false unknown depends @@ -411,6 +412,10 @@ package Exp_Util is -- N_Op_Eq), or to determine the result of some other test in other cases -- (e.g. no access check required if N_Op_Ne Null). + function Has_Controlled_Coextensions (Typ : Entity_Id) return Boolean; + -- Determine whether a record type has anonymous access discriminants with + -- a controlled designated type. + function Homonym_Number (Subp : Entity_Id) return Nat; -- Here subp is the entity for a subprogram. This routine returns the -- homonym number used to disambiguate overloaded subprograms in the same @@ -520,6 +525,11 @@ package Exp_Util is -- caller has to check whether stack checking is actually enabled in order -- to guide the expansion (typically of a function call). + function Non_Limited_Designated_Type (T : Entity_Id) return Entity_Id; + -- An anonymous access type may designate a limited view. Check whether + -- non-limited view is available during expansion, to examine components + -- or other characteristics of the full type. + function OK_To_Do_Constant_Replacement (E : Entity_Id) return Boolean; -- This function is used when testing whether or not to replace a reference -- to entity E by a known constant value. Such replacement must be done @@ -532,6 +542,14 @@ package Exp_Util is -- address might be captured in a way we do not detect. A value of True is -- returned only if the replacement is safe. + function Possible_Bit_Aligned_Component (N : Node_Id) return Boolean; + -- This function is used in processing the assignment of a record or + -- indexed component. The argument N is either the left hand or right + -- hand side of an assignment, and this function determines if there + -- is a record component reference where the record may be bit aligned + -- in a manner that causes trouble for the back end (see description + -- of Exp_Util.Component_May_Be_Bit_Aligned for further details). + procedure Remove_Side_Effects (Exp : Node_Id; Name_Req : Boolean := False; diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index 420b4de1930..a4fb2085514 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -30,7 +30,6 @@ with Einfo; use Einfo; with Errout; use Errout; with Fname; use Fname; with Fname.UF; use Fname.UF; -with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; @@ -71,6 +70,69 @@ package body Lib.Load is -- This procedure is used to generate error message info lines that -- trace the current dependency chain when a load error occurs. + ------------------------------ + -- Change_Main_Unit_To_Spec -- + ------------------------------ + + procedure Change_Main_Unit_To_Spec is + U : Unit_Record renames Units.Table (Main_Unit); + N : File_Name_Type; + X : Source_File_Index; + + begin + -- Get name of unit body + + Get_Name_String (U.Unit_File_Name); + + -- Note: for the following we should really generalize and consult the + -- file name pattern data, but for now we just deal with the common + -- naming cases, which is probably good enough in practice ??? + + -- Change .adb to .ads + + if Name_Len >= 5 + and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb" + then + Name_Buffer (Name_Len) := 's'; + + -- Change .2.ada to .1.ada (Rational convention) + + elsif Name_Len >= 7 + and then Name_Buffer (Name_Len - 5 .. Name_Len) = ".2.ada" + then + Name_Buffer (Name_Len - 4) := '1'; + + -- Change .ada to _.ada (DEC convention) + + elsif Name_Len >= 5 + and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".ada" + then + Name_Buffer (Name_Len - 3 .. Name_Len + 1) := "_.ada"; + Name_Len := Name_Len + 1; + + -- No match, don't make the change + + else + return; + end if; + + -- Try loading the spec + + N := Name_Find; + X := Load_Source_File (N); + + -- No change if we did not find the spec + + if X = No_Source_File then + return; + end if; + + -- Otherwise modify Main_Unit entry to point to spec + + U.Unit_File_Name := N; + U.Source_Index := X; + end Change_Main_Unit_To_Spec; + ------------------------------- -- Create_Dummy_Package_Unit -- ------------------------------- @@ -218,7 +280,8 @@ package body Lib.Load is ---------------------- procedure Load_Main_Source is - Fname : File_Name_Type; + Fname : File_Name_Type; + Version : Word := 0; begin Load_Stack.Increment_Last; @@ -239,13 +302,17 @@ package body Lib.Load is Main_Source_File := Load_Source_File (Fname); Current_Error_Source_File := Main_Source_File; + if Main_Source_File /= No_Source_File then + Version := Source_Checksum (Main_Source_File); + end if; + Units.Table (Main_Unit) := ( Cunit => Empty, Cunit_Entity => Empty, Dependency_Num => 0, Dynamic_Elab => False, Error_Location => No_Location, - Expected_Unit => No_Name, + Expected_Unit => No_Unit_Name, Fatal_Error => False, Generate_Code => False, Has_RACW => False, @@ -256,8 +323,8 @@ package body Lib.Load is Serial_Number => 0, Source_Index => Main_Source_File, Unit_File_Name => Fname, - Unit_Name => No_Name, - Version => Source_Checksum (Main_Source_File)); + Unit_Name => No_Unit_Name, + Version => Version); end if; end Load_Main_Source; @@ -303,13 +370,10 @@ package body Lib.Load is -- If parent is a renaming, then we use the renamed package as -- the actual parent for the subsequent load operation. - if Nkind (Parent (Cunit_Entity (Unump))) = - N_Package_Renaming_Declaration - then + if Nkind (Unit (Cunit (Unump))) = N_Package_Renaming_Declaration then Uname_Actual := New_Child - (Load_Name, - Get_Unit_Name (Name (Parent (Cunit_Entity (Unump))))); + (Load_Name, Get_Unit_Name (Name (Unit (Cunit (Unump))))); -- Save the renaming entity, to establish its visibility when -- installing the context. The implicit with is on this entity, @@ -382,7 +446,7 @@ package body Lib.Load is -- Note: Unit_Name (Main_Unit) is not set if we are parsing gnat.adc. if Present (Error_Node) - and then Unit_Name (Main_Unit) /= No_Name + and then Unit_Name (Main_Unit) /= No_Unit_Name then -- It seems like In_Extended_Main_Source_Unit (Error_Node) would -- do the trick here, but that's wrong, it is much too early to @@ -408,9 +472,6 @@ package body Lib.Load is -- If the load is called from a with_type clause, the error -- node is correct. - elsif Nkind (Parent (Error_Node)) = N_With_Type_Clause then - Load_Msg_Sloc := Sloc (Error_Node); - -- Otherwise, check for the subunit case, and if so, consider -- we have a match if one name is a prefix of the other name. @@ -474,14 +535,13 @@ package body Lib.Load is if Present (Error_Node) then if Is_Predefined_File_Name (Fname) then - Error_Msg_Name_1 := Uname_Actual; + Error_Msg_Unit_1 := Uname_Actual; Error_Msg - ("% is not a language defined unit", Load_Msg_Sloc); + ("$$ is not a language defined unit", Load_Msg_Sloc); else - Error_Msg_Name_1 := Fname; + Error_Msg_File_1 := Fname; Error_Msg_Unit_1 := Uname_Actual; - Error_Msg - ("File{ does not contain unit$", Load_Msg_Sloc); + Error_Msg ("File{ does not contain unit$", Load_Msg_Sloc); end if; Write_Dependency_Chain; @@ -604,11 +664,10 @@ package body Lib.Load is if Corr_Body /= No_Unit and then Spec_Is_Irrelevant (Unum, Corr_Body) then - Error_Msg_Name_1 := Unit_File_Name (Corr_Body); + Error_Msg_File_1 := Unit_File_Name (Corr_Body); Error_Msg - ("cannot compile subprogram in file {!", - Load_Msg_Sloc); - Error_Msg_Name_1 := Unit_File_Name (Unum); + ("cannot compile subprogram in file {!", Load_Msg_Sloc); + Error_Msg_File_1 := Unit_File_Name (Unum); Error_Msg ("\incorrect spec in file { must be removed first!", Load_Msg_Sloc); @@ -655,12 +714,12 @@ package body Lib.Load is Check_Restricted_Unit (Load_Name, Error_Node); - Error_Msg_Name_1 := Uname_Actual; + Error_Msg_Unit_1 := Uname_Actual; Error_Msg - ("% is not a predefined library unit", Load_Msg_Sloc); + ("$$ is not a predefined library unit", Load_Msg_Sloc); else - Error_Msg_Name_1 := Fname; + Error_Msg_File_1 := Fname; Error_Msg ("file{ not found", Load_Msg_Sloc); end if; diff --git a/gcc/ada/lib-load.ads b/gcc/ada/lib-load.ads index cd8555827de..6ea1e815940 100644 --- a/gcc/ada/lib-load.ads +++ b/gcc/ada/lib-load.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -153,6 +153,15 @@ package Lib.Load is -- limited-with clause, or some unit in the context of X. It is used to -- avoid the check on circular dependency (Ada 2005, AI-50217) + procedure Change_Main_Unit_To_Spec; + -- This procedure is called if the main unit file contains a No_Body pragma + -- and no other tokens. The effect is, if possible, to change the main unit + -- from the body it references now, to the corresponding spec. This has the + -- effect of ignoring the body, which is what we want. If it is impossible + -- to successfully make the change, then the call has no effect, and the + -- file is unchanged (this will lead to an error complaining about the + -- inappropriate No_Body spec). + function Create_Dummy_Package_Unit (With_Node : Node_Id; Spec_Name : Unit_Name_Type) return Unit_Number_Type; diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb index 8066336e491..f013cf112ca 100644 --- a/gcc/ada/par-ch10.adb +++ b/gcc/ada/par-ch10.adb @@ -869,22 +869,17 @@ package body Ch10 is if Token = Tok_Type then - -- WITH TYPE is an GNAT specific extension + -- WITH TYPE is an obsolete GNAT specific extension - if not Extensions_Allowed then - Error_Msg_SP ("`WITH TYPE` is a 'G'N'A'T extension"); - Error_Msg_SP ("\unit must be compiled with -gnatX switch"); - end if; + Error_Msg_SP + ("`WITH TYPE` is an obsolete 'G'N'A'T extension"); + Error_Msg_SP ("\use Ada 2005 `LIMITED WITH` clause instead"); Scan; -- past TYPE - With_Node := New_Node (N_With_Type_Clause, Token_Ptr); - Append (With_Node, Item_List); - Set_Name (With_Node, P_Qualified_Simple_Name); T_Is; if Token = Tok_Tagged then - Set_Tagged_Present (With_Node); Scan; elsif Token = Tok_Access then diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 6d0f28917bf..58ae0456f3c 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -727,14 +727,6 @@ package body Sinfo is return Node4 (N); end Delay_Alternative; - function Delay_Finalize_Attach - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration); - return Flag14 (N); - end Delay_Finalize_Attach; - function Delay_Statement (N : Node_Id) return Node_Id is begin @@ -1101,11 +1093,12 @@ package body Sinfo is (N : Node_Id) return Boolean is begin pragma Assert (False + or else NT (N).Nkind = N_Block_Statement or else NT (N).Nkind = N_Goto_Statement or else NT (N).Nkind = N_Label or else NT (N).Nkind = N_Object_Declaration or else NT (N).Nkind = N_Subtype_Declaration); - return Flag7 (N); + return Flag8 (N); end Exception_Junk; function Exception_Label @@ -1360,6 +1353,22 @@ package body Sinfo is return Flag12 (N); end Has_Dynamic_Range_Check; + function Has_Init_Expression + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Object_Declaration); + return Flag14 (N); + end Has_Init_Expression; + + function Has_Local_Raise + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Exception_Handler); + return Flag8 (N); + end Has_Local_Raise; + function Has_No_Elaboration_Code (N : Node_Id) return Boolean is begin @@ -1629,6 +1638,14 @@ package body Sinfo is return Flag7 (N); end Is_Protected_Subprogram_Body; + function Is_Static_Coextension + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Allocator); + return Flag14 (N); + end Is_Static_Coextension; + function Is_Static_Expression (N : Node_Id) return Boolean is begin @@ -1900,8 +1917,7 @@ package body Sinfo is or else NT (N).Nkind = N_Subprogram_Renaming_Declaration or else NT (N).Nkind = N_Subunit or else NT (N).Nkind = N_Variant_Part - or else NT (N).Nkind = N_With_Clause - or else NT (N).Nkind = N_With_Type_Clause); + or else NT (N).Nkind = N_With_Clause); return Node2 (N); end Name; @@ -2348,6 +2364,14 @@ package body Sinfo is return Flag13 (N); end Redundant_Use; + function Renaming_Exception + (N : Node_Id) return Node_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Exception_Declaration); + return Node2 (N); + end Renaming_Exception; + function Result_Definition (N : Node_Id) return Node_Id is begin @@ -2576,8 +2600,7 @@ package body Sinfo is or else NT (N).Nkind = N_Formal_Private_Type_Definition or else NT (N).Nkind = N_Incomplete_Type_Declaration or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Record_Definition - or else NT (N).Nkind = N_With_Type_Clause); + or else NT (N).Nkind = N_Record_Definition); return Flag15 (N); end Tagged_Present; @@ -3412,14 +3435,6 @@ package body Sinfo is Set_Node4_With_Parent (N, Val); end Set_Delay_Alternative; - procedure Set_Delay_Finalize_Attach - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Object_Declaration); - Set_Flag14 (N, Val); - end Set_Delay_Finalize_Attach; - procedure Set_Delay_Statement (N : Node_Id; Val : Node_Id) is begin @@ -3777,11 +3792,12 @@ package body Sinfo is (N : Node_Id; Val : Boolean := True) is begin pragma Assert (False + or else NT (N).Nkind = N_Block_Statement or else NT (N).Nkind = N_Goto_Statement or else NT (N).Nkind = N_Label or else NT (N).Nkind = N_Object_Declaration or else NT (N).Nkind = N_Subtype_Declaration); - Set_Flag7 (N, Val); + Set_Flag8 (N, Val); end Set_Exception_Junk; procedure Set_Exception_Label @@ -4036,6 +4052,22 @@ package body Sinfo is Set_Flag12 (N, Val); end Set_Has_Dynamic_Range_Check; + procedure Set_Has_Init_Expression + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Object_Declaration); + Set_Flag14 (N, Val); + end Set_Has_Init_Expression; + + procedure Set_Has_Local_Raise + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Exception_Handler); + Set_Flag8 (N, Val); + end Set_Has_Local_Raise; + procedure Set_Has_No_Elaboration_Code (N : Node_Id; Val : Boolean := True) is begin @@ -4305,6 +4337,14 @@ package body Sinfo is Set_Flag7 (N, Val); end Set_Is_Protected_Subprogram_Body; + procedure Set_Is_Static_Coextension + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Allocator); + Set_Flag14 (N, Val); + end Set_Is_Static_Coextension; + procedure Set_Is_Static_Expression (N : Node_Id; Val : Boolean := True) is begin @@ -4576,8 +4616,7 @@ package body Sinfo is or else NT (N).Nkind = N_Subprogram_Renaming_Declaration or else NT (N).Nkind = N_Subunit or else NT (N).Nkind = N_Variant_Part - or else NT (N).Nkind = N_With_Clause - or else NT (N).Nkind = N_With_Type_Clause); + or else NT (N).Nkind = N_With_Clause); Set_Node2_With_Parent (N, Val); end Set_Name; @@ -5024,6 +5063,14 @@ package body Sinfo is Set_Flag13 (N, Val); end Set_Redundant_Use; + procedure Set_Renaming_Exception + (N : Node_Id; Val : Node_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Exception_Declaration); + Set_Node2 (N, Val); + end Set_Renaming_Exception; + procedure Set_Result_Definition (N : Node_Id; Val : Node_Id) is begin @@ -5252,8 +5299,7 @@ package body Sinfo is or else NT (N).Nkind = N_Formal_Private_Type_Definition or else NT (N).Nkind = N_Incomplete_Type_Declaration or else NT (N).Nkind = N_Private_Type_Declaration - or else NT (N).Nkind = N_Record_Definition - or else NT (N).Nkind = N_With_Type_Clause); + or else NT (N).Nkind = N_Record_Definition); Set_Flag15 (N, Val); end Set_Tagged_Present; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 85fbcf1f9a3..ccf63ed645e 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -48,6 +48,7 @@ -- WARNING: Several files are automatically generated from this package. -- See below for details. +with Namet; use Namet; with Types; use Types; with Uintp; use Uintp; with Urealp; use Urealp; @@ -462,10 +463,6 @@ package Sinfo is -- already been analyzed, both for efficiency and functional correctness -- reasons. - -- Coextensions (Elist4-Sem) - -- Present in allocators nodes. Points to list of allocators for the - -- access discriminants of the allocated object, - -- Comes_From_Source (Flag2) -- This flag is on for any nodes built by the scanner or parser from the -- source program, and off for any nodes built by the analyzer or @@ -485,7 +482,9 @@ package Sinfo is -- points to a list of raise nodes, which are calls to a routine to raise -- an exception. These are raise nodes which can be optimized into gotos -- if the handler turns out to meet the conditions which permit this - -- transformation. + -- transformation. Note that this does NOT include instances of the + -- N_Raise_xxx_Error nodes since the transformation of these nodes is + -- handled by the back end (using the N_Push/N_Pop mechanism). -- Has_Dynamic_Length_Check (Flag10-Sem) -- This flag is present on all nodes. It is set to indicate that one of @@ -499,6 +498,13 @@ package Sinfo is -- has been inserted at the flagged node. This is used to avoid the -- generation of duplicate checks. + -- Has_Local_Raise (Flag8-Sem) + -- Present in exception handler nodes. Set if the handler can be entered + -- via a local raise that gets transformed to a goto statement. This will + -- always be set if Local_Raise_Statements is non-empty, but can also be + -- set as a result of generation of N_Raise_xxx nodes, or flags set in + -- nodes requiring generation of back end checks. + ------------------------------------ -- Description of Semantic Fields -- ------------------------------------ @@ -660,6 +666,10 @@ package Sinfo is -- attribute definition clause is given, rather than testing this at the -- freeze point. + -- Coextensions (Elist4-Sem) + -- Present in allocators nodes. Points to list of allocators for the + -- access discriminants of the allocated object. + -- Comes_From_Extended_Return_Statement (Flag18-Sem) -- Present in N_Return_Statement nodes. True if this node was -- constructed as part of the expansion of an @@ -767,14 +777,6 @@ package Sinfo is -- for the default expression). Default_Expression is used for -- conformance checking. - -- Delay_Finalize_Attach (Flag14-Sem) - -- This flag is present in an N_Object_Declaration node. If it is set, - -- then in the case of a controlled type being declared and initialized, - -- the normal code for attaching the result to the appropriate local - -- finalization list is suppressed. This is used for functions that - -- return controlled types without using the secondary stack, where it is - -- the caller who must do the attachment. - -- Discr_Check_Funcs_Built (Flag11-Sem) -- This flag is present in N_Full_Type_Declaration nodes. It is set when -- discriminant checking functions are constructed. The purpose is to @@ -950,7 +952,7 @@ package Sinfo is -- points to an essentially arbitrary choice from the possible set of -- types. - -- Exception_Junk (Flag7-Sem) + -- Exception_Junk (Flag8-Sem) -- This flag is set in a various nodes appearing in a statement sequence -- to indicate that the corresponding node is an artifact of the -- generated code for exception handling, and should be ignored when @@ -1211,6 +1213,10 @@ package Sinfo is -- handler to make sure that the associated protected object is unlocked -- when the subprogram completes. + -- Is_Static_Coextension (Flag14-Sem) + -- Present in N_Allocator nodes. Set if the allocator is a coextension + -- of an object allocated on the stack rather than the heap. + -- Is_Static_Expression (Flag6-Sem) -- Indicates that an expression is a static expression (RM 4.9). See spec -- of package Sem_Eval for full details on the use of this flag. @@ -1482,6 +1488,14 @@ package Sinfo is -- to indicate that a use is redundant (and therefore need not be undone -- on scope exit). + -- Renaming_Exception (Node2-Sem) + -- Present in N_Exception_Declaration node. Used to point back to the + -- exception renaming for an exception declared within a subprogram. + -- What happens is that an exception declared in a subprogram is moved + -- to the library level with a unique name, and the original exception + -- becomes a renaming. This link from the library level exception to the + -- renaming declaration allows registering of the proper exception name. + -- Return_Statement_Entity (Node5-Sem) -- Present in N_Return_Statement and N_Extended_Return_Statement. -- Points to an E_Return_Statement representing the return statement. @@ -1967,7 +1981,7 @@ package Sinfo is -- Null_Exclusion_Present (Flag11) -- Subtype_Indication (Node5) -- Generic_Parent_Type (Node4-Sem) (set for an actual derived type). - -- Exception_Junk (Flag7-Sem) + -- Exception_Junk (Flag8-Sem) ------------------------------- -- 3.2.2 Subtype Indication -- @@ -2055,6 +2069,13 @@ package Sinfo is -- Prev_Ids flags to preserve the original source form as described -- in the section on "Handling of Defining Identifier Lists". + -- The flag Has_Init_Expression is set if an initializing expression + -- is present. Normally it is set if and only if Expression contains + -- a non-empty value, but there is an exception to this. When the + -- initializing expression is an aggregate which requires explicit + -- assignments, the Expression field gets set to Empty, but this flag + -- is still set, so we don't forget we had an initializing expression. + -- Note: if a range check is required for the initialization -- expression then the Do_Range_Check flag is set in the Expression, -- with the check being done against the type given by the object @@ -2091,9 +2112,9 @@ package Sinfo is -- Prev_Ids (Flag6) (set to False if no previous identifiers in list) -- No_Initialization (Flag13-Sem) -- Assignment_OK (Flag15-Sem) - -- Exception_Junk (Flag7-Sem) - -- Delay_Finalize_Attach (Flag14-Sem) + -- Exception_Junk (Flag8-Sem) -- Is_Subprogram_Descriptor (Flag16-Sem) + -- Has_Init_Expression (Flag14) ------------------------------------- -- 3.3.1 Defining Identifier List -- @@ -3643,6 +3664,7 @@ package Sinfo is -- Procedure_To_Call (Node2-Sem) -- Coextensions (Elist4-Sem) -- No_Initialization (Flag13-Sem) + -- Is_Static_Coextension (Flag14-Sem) -- Do_Storage_Check (Flag17-Sem) -- Is_Coextension (Flag18-Sem) -- plus fields for expression @@ -3718,7 +3740,7 @@ package Sinfo is -- N_Label -- Sloc points to << -- Identifier (Node1) direct name of statement identifier - -- Exception_Junk (Flag7-Sem) + -- Exception_Junk (Flag8-Sem) ------------------------------- -- 5.1 Statement Identifier -- @@ -3921,9 +3943,12 @@ package Sinfo is -- True. Blocks constructed by the expander usually have no identifier, -- and no corresponding entity. - -- Note well: the block statement created for an extended return - -- statement has an entity, and this entity is an E_Return_Statement, - -- rather than the usual E_Block. + -- Note: the block statement created for an extended return statement + -- has an entity, and this entity is an E_Return_Statement, rather than + -- the usual E_Block. + + -- Note: Exception_Junk is set for the wrapping blocks created during + -- local raise optimization (Exp_Ch11.Expand_Local_Exception_Handlers). -- N_Block_Statement -- Sloc points to DECLARE or BEGIN @@ -3935,6 +3960,7 @@ package Sinfo is -- Has_Created_Identifier (Flag15) -- Is_Task_Allocation_Block (Flag6) -- Is_Asynchronous_Call_Block (Flag7) + -- Exception_Junk (Flag8-Sem) ------------------------- -- 5.7 Exit Statement -- @@ -3960,7 +3986,7 @@ package Sinfo is -- N_Goto_Statement -- Sloc points to GOTO -- Name (Node2) - -- Exception_Junk (Flag7-Sem) + -- Exception_Junk (Flag8-Sem) --------------------------------- -- 6.1 Subprogram Declaration -- @@ -5374,14 +5400,8 @@ package Sinfo is -- This is a GNAT extension, used to implement mutually recursive -- types declared in different packages. - - -- WITH_TYPE_CLAUSE ::= - -- with type type_NAME is access | with type type_NAME is tagged - - -- N_With_Type_Clause - -- Sloc points to first token of type name - -- Name (Node2) - -- Tagged_Present (Flag15) + -- Note: this is now obsolete. The functionality of this construct + -- is now implemented by the Ada 2005 Limited_with_Clause. --------------------- -- 10.2 Body stub -- @@ -5475,6 +5495,7 @@ package Sinfo is -- Sloc points to EXCEPTION -- Defining_Identifier (Node1) -- Expression (Node3-Sem) + -- Renaming_Exception (Node2-Sem) -- More_Ids (Flag5) (set to False if no more identifiers in list) -- Prev_Ids (Flag6) (set to False if no previous identifiers in list) @@ -5565,6 +5586,7 @@ package Sinfo is -- Zero_Cost_Handling (Flag5-Sem) -- Local_Raise_Statements (Elist1-Sem) (set to No_Elist if not present) -- Local_Raise_Not_OK (Flag7-Sem) + -- Has_Local_Raise (Flag8-Sem) ------------------------------------------ -- 11.2 Choice parameter specification -- @@ -7093,13 +7115,13 @@ package Sinfo is N_Formal_Abstract_Subprogram_Declaration, N_Formal_Concrete_Subprogram_Declaration, - -- N_Push_xxx_Label + -- N_Push_xxx_Label, N_Push_Pop_xxx_Label N_Push_Constraint_Error_Label, N_Push_Program_Error_Label, N_Push_Storage_Error_Label, - -- N_Pop_xxx_Label + -- N_Pop_xxx_Label, N_Push_Pop_xxx_Label N_Pop_Constraint_Error_Label, N_Pop_Program_Error_Label, @@ -7168,7 +7190,6 @@ package Sinfo is N_Variant, N_Variant_Part, N_With_Clause, - N_With_Type_Clause, N_Unused_At_End); for Node_Kind'Size use 8; @@ -7296,6 +7317,10 @@ package Sinfo is N_Pop_Constraint_Error_Label .. N_Pop_Storage_Error_Label; + subtype N_Push_Pop_xxx_Label is Node_Kind range + N_Push_Constraint_Error_Label .. + N_Pop_Storage_Error_Label; + subtype N_Raise_xxx_Error is Node_Kind range N_Raise_Constraint_Error .. N_Raise_Storage_Error; @@ -7561,9 +7586,6 @@ package Sinfo is function Delay_Alternative (N : Node_Id) return Node_Id; -- Node4 - function Delay_Finalize_Attach - (N : Node_Id) return Boolean; -- Flag14 - function Delay_Statement (N : Node_Id) return Node_Id; -- Node2 @@ -7685,7 +7707,7 @@ package Sinfo is (N : Node_Id) return List_Id; -- List5 function Exception_Junk - (N : Node_Id) return Boolean; -- Flag7 + (N : Node_Id) return Boolean; -- Flag8 function Exception_Label (N : Node_Id) return Node_Id; -- Node5 @@ -7765,6 +7787,12 @@ package Sinfo is function Has_Dynamic_Range_Check (N : Node_Id) return Boolean; -- Flag12 + function Has_Init_Expression + (N : Node_Id) return Boolean; -- Flag14 + + function Has_Local_Raise + (N : Node_Id) return Boolean; -- Flag8 + function Has_No_Elaboration_Code (N : Node_Id) return Boolean; -- Flag17 @@ -7855,6 +7883,9 @@ package Sinfo is function Is_Protected_Subprogram_Body (N : Node_Id) return Boolean; -- Flag7 + function Is_Static_Coextension + (N : Node_Id) return Boolean; -- Flag14 + function Is_Static_Expression (N : Node_Id) return Boolean; -- Flag6 @@ -8071,6 +8102,9 @@ package Sinfo is function Redundant_Use (N : Node_Id) return Boolean; -- Flag13 + function Renaming_Exception + (N : Node_Id) return Node_Id; -- Node2 + function Result_Definition (N : Node_Id) return Node_Id; -- Node4 @@ -8410,9 +8444,6 @@ package Sinfo is procedure Set_Delay_Alternative (N : Node_Id; Val : Node_Id); -- Node4 - procedure Set_Delay_Finalize_Attach - (N : Node_Id; Val : Boolean := True); -- Flag14 - procedure Set_Delay_Statement (N : Node_Id; Val : Node_Id); -- Node2 @@ -8531,7 +8562,7 @@ package Sinfo is (N : Node_Id; Val : List_Id); -- List5 procedure Set_Exception_Junk - (N : Node_Id; Val : Boolean := True); -- Flag7 + (N : Node_Id; Val : Boolean := True); -- Flag8 procedure Set_Exception_Label (N : Node_Id; Val : Node_Id); -- Node5 @@ -8611,6 +8642,12 @@ package Sinfo is procedure Set_Has_Dynamic_Range_Check (N : Node_Id; Val : Boolean := True); -- Flag12 + procedure Set_Has_Init_Expression + (N : Node_Id; Val : Boolean := True); -- Flag14 + + procedure Set_Has_Local_Raise + (N : Node_Id; Val : Boolean := True); -- Flag8 + procedure Set_Has_No_Elaboration_Code (N : Node_Id; Val : Boolean := True); -- Flag17 @@ -8701,6 +8738,9 @@ package Sinfo is procedure Set_Is_Protected_Subprogram_Body (N : Node_Id; Val : Boolean := True); -- Flag7 + procedure Set_Is_Static_Coextension + (N : Node_Id; Val : Boolean := True); -- Flag14 + procedure Set_Is_Static_Expression (N : Node_Id; Val : Boolean := True); -- Flag6 @@ -8917,6 +8957,9 @@ package Sinfo is procedure Set_Redundant_Use (N : Node_Id; Val : Boolean := True); -- Flag13 + procedure Set_Renaming_Exception + (N : Node_Id; Val : Node_Id); -- Node2 + procedure Set_Result_Definition (N : Node_Id; Val : Node_Id); -- Node4 @@ -10142,13 +10185,6 @@ package Sinfo is 4 => False, -- Library_Unit (Node4-Sem) 5 => False), -- Corresponding_Spec (Node5-Sem) - N_With_Type_Clause => - (1 => False, -- unused - 2 => True, -- Name (Node2) - 3 => False, -- unused - 4 => False, -- unused - 5 => False), -- unused - N_Subprogram_Body_Stub => (1 => True, -- Specification (Node1) 2 => False, -- unused @@ -10683,7 +10719,6 @@ package Sinfo is pragma Inline (Defining_Identifier); pragma Inline (Defining_Unit_Name); pragma Inline (Delay_Alternative); - pragma Inline (Delay_Finalize_Attach); pragma Inline (Delay_Statement); pragma Inline (Delta_Expression); pragma Inline (Digits_Expression); @@ -10751,6 +10786,8 @@ package Sinfo is pragma Inline (Has_Created_Identifier); pragma Inline (Has_Dynamic_Length_Check); pragma Inline (Has_Dynamic_Range_Check); + pragma Inline (Has_Init_Expression); + pragma Inline (Has_Local_Raise); pragma Inline (Has_Self_Reference); pragma Inline (Has_No_Elaboration_Code); pragma Inline (Has_Priority_Pragma); @@ -10781,6 +10818,7 @@ package Sinfo is pragma Inline (Is_Overloaded); pragma Inline (Is_Power_Of_2_For_Shift); pragma Inline (Is_Protected_Subprogram_Body); + pragma Inline (Is_Static_Coextension); pragma Inline (Is_Static_Expression); pragma Inline (Is_Subprogram_Descriptor); pragma Inline (Is_Task_Allocation_Block); @@ -10853,6 +10891,7 @@ package Sinfo is pragma Inline (Reason); pragma Inline (Record_Extension_Part); pragma Inline (Redundant_Use); + pragma Inline (Renaming_Exception); pragma Inline (Result_Definition); pragma Inline (Return_Object_Declarations); pragma Inline (Return_Statement_Entity); @@ -10963,7 +11002,6 @@ package Sinfo is pragma Inline (Set_Defining_Identifier); pragma Inline (Set_Defining_Unit_Name); pragma Inline (Set_Delay_Alternative); - pragma Inline (Set_Delay_Finalize_Attach); pragma Inline (Set_Delay_Statement); pragma Inline (Set_Delta_Expression); pragma Inline (Set_Digits_Expression); @@ -11029,6 +11067,8 @@ package Sinfo is pragma Inline (Set_Handler_List_Entry); pragma Inline (Set_Has_Created_Identifier); pragma Inline (Set_Has_Dynamic_Length_Check); + pragma Inline (Set_Has_Init_Expression); + pragma Inline (Set_Has_Local_Raise); pragma Inline (Set_Has_Dynamic_Range_Check); pragma Inline (Set_Has_No_Elaboration_Code); pragma Inline (Set_Has_Priority_Pragma); @@ -11060,6 +11100,7 @@ package Sinfo is pragma Inline (Set_Is_Power_Of_2_For_Shift); pragma Inline (Set_Is_Protected_Subprogram_Body); pragma Inline (Set_Has_Self_Reference); + pragma Inline (Set_Is_Static_Coextension); pragma Inline (Set_Is_Static_Expression); pragma Inline (Set_Is_Subprogram_Descriptor); pragma Inline (Set_Is_Task_Allocation_Block); @@ -11131,6 +11172,7 @@ package Sinfo is pragma Inline (Set_Reason); pragma Inline (Set_Record_Extension_Part); pragma Inline (Set_Redundant_Use); + pragma Inline (Set_Renaming_Exception); pragma Inline (Set_Result_Definition); pragma Inline (Set_Return_Object_Declarations); pragma Inline (Set_Reverse_Present); -- 2.30.2