diff options
Diffstat (limited to 'gcc')
36 files changed, 588 insertions, 472 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ce029b4a8d1..7777a8a833d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,65 @@ +2013-10-17 Thomas Quinot <quinot@adacore.com> + + * exp_ch7.adb: Minor reformatting. + +2013-10-17 Ed Schonberg <schonberg@adacore.com> + + * sem_dim.adb (Process_Minus, Process_Divide): Label dimension + expression with standard operator and type, for pretty-printing + use. + +2013-10-17 Bob Duff <duff@adacore.com> + + * gnat_ugn.texi: Document --pp-new and --pp-old switches. + +2013-10-17 Hristian Kirtchev <kirtchev@adacore.com> + + * einfo.adb: Flag 159 is now known as From_Limited_With. Replace + all references to attribute From_With_Type with From_Limited_With. + (From_With_Type): Renamed to From_Limited_With. + (Set_From_With_Type): Renamd to Set_From_Limited_With. + * einfo.ads: Remove attribute From_With_Type and occurrences in + nodes. Add attribute From_Limited_With along with occurrences + in nodes. + (From_With_Type): Renamed to From_Limited_With along with pragma Inline. + (Set_From_With_Type): Renamed to + Set_From_Limited_With along with pragma Inline. + * sem_ch7.adb, sem_ch8.adb, sem_ch12.adb, sem_ch13.adb, sem_disp.adb, + sem_res.adb, sem_type.adb, sem_util.adb, sem_warn.adb, + exp_attr.adb, exp_disp.adb, freeze.adb, itypes.adb, layout.adb, + lib-writ.adb, rtsfind.adb, sem_attr.adb, sem_aux.adb, sem_ch3.adb, + sem_ch4.adb: Replace all references to attribute From_With_Type + with From_Limited_With. + * sem_ch6.adb: Replace all references to attribute From_With_Type + with From_Limited_With. + (Designates_From_With_Type): Renamed to Designates_From_Limited_With. + (Process_Formals): Update the call to Designates_From_With_Type. + * sem_ch10.adb: Replace all references to attribute From_With_Type + with From_Limited_With. + (Build_Limited_Views): Reimplemented. + * gcc-interface/decl.c Replace all references to attribute + From_With_Type with From_Limited_With. + (finalize_from_with_types): Renamed to finalize_from_limited_with. + * gcc-interface/gigi.h (finalize_from_with_types): Renamed to + finalize_from_limited_with. + * gcc-interface/trans.c: Replace all references to attribute + From_With_Type with From_Limited_With. + (Compilation_Unit_to_gnu): Update the call to finalize_from_with_types. + +2013-10-17 Pascal Obry <obry@adacore.com> + + * projects.texi: Update VCS_Kind documentation. + +2013-10-17 Matthew Heaney <heaney@adacore.com> + + * a-convec.adb, a-coinve.adb, a-cobove.adb (Insert, Insert_Space): + Inspect value range before converting type. + +2013-10-17 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_prag.adb (Analyze_Pragma): Flag the use of pragma Refined_Pre as + illegal. + 2013-10-17 Vincent Celier <celier@adacore.com> * gnat_ugn.texi: Remove VMS conversion of -gnatet and -gnateT, diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb index c2790517e01..bcd6118e607 100644 --- a/gcc/ada/a-cobove.adb +++ b/gcc/ada/a-cobove.adb @@ -1227,7 +1227,22 @@ package body Ada.Containers.Bounded_Vectors is -- worry about if No_Index were less than 0, but that case is -- handled above). - Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + if Index_Type'Last - No_Index >= + Count_Type'Pos (Count_Type'Last) + then + -- We have determined that range of Index_Type has at least as + -- many values as in Count_Type, so Count_Type'Last is the + -- maximum number of items that are allowed. + + Max_Length := Count_Type'Last; + + else + -- The range of Index_Type has fewer values than in Count_Type, + -- so the maximum number of items is computed from the range of + -- the Index_Type. + + Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + end if; end if; elsif Index_Type'First <= 0 then @@ -1685,7 +1700,22 @@ package body Ada.Containers.Bounded_Vectors is -- worry about if No_Index were less than 0, but that case is -- handled above). - Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + if Index_Type'Last - No_Index >= + Count_Type'Pos (Count_Type'Last) + then + -- We have determined that range of Index_Type has at least as + -- many values as in Count_Type, so Count_Type'Last is the + -- maximum number of items that are allowed. + + Max_Length := Count_Type'Last; + + else + -- The range of Index_Type has fewer values than in Count_Type, + -- so the maximum number of items is computed from the range of + -- the Index_Type. + + Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + end if; end if; elsif Index_Type'First <= 0 then diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index cff3a286edb..677fd97e09d 100644 --- a/gcc/ada/a-coinve.adb +++ b/gcc/ada/a-coinve.adb @@ -1734,7 +1734,22 @@ package body Ada.Containers.Indefinite_Vectors is -- worry about if No_Index were less than 0, but that case is -- handled above). - Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + if Index_Type'Last - No_Index >= + Count_Type'Pos (Count_Type'Last) + then + -- We have determined that range of Index_Type has at least as + -- many values as in Count_Type, so Count_Type'Last is the + -- maximum number of items that are allowed. + + Max_Length := Count_Type'Last; + + else + -- The range of Index_Type has fewer values than in Count_Type, + -- so the maximum number of items is computed from the range of + -- the Index_Type. + + Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + end if; end if; elsif Index_Type'First <= 0 then @@ -2504,7 +2519,22 @@ package body Ada.Containers.Indefinite_Vectors is -- worry about if No_Index were less than 0, but that case is -- handled above). - Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + if Index_Type'Last - No_Index >= + Count_Type'Pos (Count_Type'Last) + then + -- We have determined that range of Index_Type has at least as + -- many values as in Count_Type, so Count_Type'Last is the + -- maximum number of items that are allowed. + + Max_Length := Count_Type'Last; + + else + -- The range of Index_Type has fewer values than in Count_Type, + -- so the maximum number of items is computed from the range of + -- the Index_Type. + + Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + end if; end if; elsif Index_Type'First <= 0 then diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index 5b722fe8a72..0f4bc19bcba 100644 --- a/gcc/ada/a-convec.adb +++ b/gcc/ada/a-convec.adb @@ -1386,7 +1386,22 @@ package body Ada.Containers.Vectors is -- worry about if No_Index were less than 0, but that case is -- handled above). - Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + if Index_Type'Last - No_Index >= + Count_Type'Pos (Count_Type'Last) + then + -- We have determined that range of Index_Type has at least as + -- many values as in Count_Type, so Count_Type'Last is the + -- maximum number of items that are allowed. + + Max_Length := Count_Type'Last; + + else + -- The range of Index_Type has fewer values than in Count_Type, + -- so the maximum number of items is computed from the range of + -- the Index_Type. + + Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + end if; end if; elsif Index_Type'First <= 0 then @@ -2033,7 +2048,22 @@ package body Ada.Containers.Vectors is -- worry about if No_Index were less than 0, but that case is -- handled above). - Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + if Index_Type'Last - No_Index >= + Count_Type'Pos (Count_Type'Last) + then + -- We have determined that range of Index_Type has at least as + -- many values as in Count_Type, so Count_Type'Last is the + -- maximum number of items that are allowed. + + Max_Length := Count_Type'Last; + + else + -- The range of Index_Type has fewer values than in Count_Type, + -- so the maximum number of items is computed from the range of + -- the Index_Type. + + Max_Length := Count_Type'Base (Index_Type'Last - No_Index); + end if; end if; elsif Index_Type'First <= 0 then diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 5047ec257ce..5a8757bac40 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -437,7 +437,7 @@ package body Einfo is -- Referenced Flag156 -- Has_Pragma_Inline Flag157 -- Finalize_Storage_Only Flag158 - -- From_With_Type Flag159 + -- From_Limited_With Flag159 -- Is_Package_Body_Entity Flag160 -- Has_Qualified_Name Flag161 @@ -1242,10 +1242,10 @@ package body Einfo is return Node7 (Id); end Freeze_Node; - function From_With_Type (Id : E) return B is + function From_Limited_With (Id : E) return B is begin return Flag159 (Id); - end From_With_Type; + end From_Limited_With; function Full_View (Id : E) return E is begin @@ -3863,13 +3863,11 @@ package body Einfo is Set_Node7 (Id, V); end Set_Freeze_Node; - procedure Set_From_With_Type (Id : E; V : B := True) is + procedure Set_From_Limited_With (Id : E; V : B := True) is begin - pragma Assert - (Is_Type (Id) - or else Ekind (Id) = E_Package); + pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Package); Set_Flag159 (Id, V); - end Set_From_With_Type; + end Set_From_Limited_With; procedure Set_Full_View (Id : E; V : E) is begin @@ -7899,7 +7897,7 @@ package body Einfo is -- view then we return the Underlying_Type of its non-limited -- view. - elsif From_With_Type (Id) + elsif From_Limited_With (Id) and then Present (Non_Limited_View (Id)) then return Underlying_Type (Non_Limited_View (Id)); @@ -8002,7 +8000,7 @@ package body Einfo is W ("Entry_Accepted", Flag152 (Id)); W ("Can_Use_Internal_Rep", Flag229 (Id)); W ("Finalize_Storage_Only", Flag158 (Id)); - W ("From_With_Type", Flag159 (Id)); + W ("From_Limited_With", Flag159 (Id)); W ("Has_Aliased_Components", Flag135 (Id)); W ("Has_Alignment_Clause", Flag46 (Id)); W ("Has_All_Calls_Remote", Flag79 (Id)); @@ -8698,14 +8696,13 @@ package body Einfo is procedure Write_Field16_Name (Id : Entity_Id) is begin case Ekind (Id) is - - when E_Abstract_State => - Write_Str ("Body_References"); - when E_Record_Type | E_Record_Type_With_Private => Write_Str ("Access_Disp_Table"); + when E_Abstract_State => + Write_Str ("Body_References"); + when E_Record_Subtype | E_Class_Wide_Subtype => Write_Str ("Cloned_Subtype"); @@ -8794,7 +8791,7 @@ package body Einfo is Write_Str ("Non_Limited_View"); when E_Incomplete_Subtype => - if From_With_Type (Id) then + if From_Limited_With (Id) then Write_Str ("Non_Limited_View"); end if; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 6520fe6bdad..0eaf13b43f1 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1315,19 +1315,11 @@ package Einfo is -- associated with the entity, then this field is Empty. See package -- Freeze for further details. --- From_With_Type (Flag159) --- Defined in package and type entities. Indicates that the entity --- appears in a With_Type clause in the context of some other unit, --- either as the prefix (which must be a package), or as a type name. --- The package can only be used to retrieve such a type, and the type --- can be used only in component declarations and access definitions. --- The With_Type clause is used to construct mutually recursive --- types, i.e. record types (Java classes) that hold pointers to each --- other. If such a type is an access type, it has no explicit freeze --- node, so that the back-end does not attempt to elaborate it. --- Currently this flag is also used to implement Ada 2005 (AI-50217). --- It will be renamed to From_Limited_With after removal of the current --- GNAT with_type clause??? +-- From_Limited_With (Flag159) +-- Defined in package and type entities. Set to True when the related +-- entity is generated by the expansion of a limited with clause. Such +-- an entity is said to be a "shadow" - it acts as the incomplete view +-- of a type by inheriting relevant attributes from the said type. -- Full_View (Node11) -- Defined in all type and subtype entities and in deferred constants. @@ -5049,7 +5041,7 @@ package Einfo is -- Depends_On_Private (Flag14) -- Discard_Names (Flag88) -- Finalize_Storage_Only (Flag158) (base type only) - -- From_With_Type (Flag159) + -- From_Limited_With (Flag159) -- Has_Aliased_Components (Flag135) (base type only) -- Has_Alignment_Clause (Flag46) -- Has_Atomic_Components (Flag86) (base type only) @@ -5662,7 +5654,7 @@ package Einfo is -- Discard_Names (Flag88) -- Elaboration_Entity_Required (Flag174) -- Elaborate_Body_Desirable (Flag210) (non-generic case only) - -- From_With_Type (Flag159) + -- From_Limited_With (Flag159) -- Has_All_Calls_Remote (Flag79) -- Has_Anonymous_Master (Flag253) -- Has_Completion (Flag26) @@ -6327,7 +6319,7 @@ package Einfo is function First_Rep_Item (Id : E) return N; function Float_Rep (Id : E) return F; function Freeze_Node (Id : E) return N; - function From_With_Type (Id : E) return B; + function From_Limited_With (Id : E) return B; function Full_View (Id : E) return E; function Generic_Homonym (Id : E) return E; function Generic_Renamings (Id : E) return L; @@ -6946,7 +6938,7 @@ package Einfo is procedure Set_First_Rep_Item (Id : E; V : N); procedure Set_Float_Rep (Id : E; V : F); procedure Set_Freeze_Node (Id : E; V : N); - procedure Set_From_With_Type (Id : E; V : B := True); + procedure Set_From_Limited_With (Id : E; V : B := True); procedure Set_Full_View (Id : E; V : E); procedure Set_Generic_Homonym (Id : E; V : E); procedure Set_Generic_Renamings (Id : E; V : L); @@ -7666,7 +7658,7 @@ package Einfo is pragma Inline (First_Private_Entity); pragma Inline (First_Rep_Item); pragma Inline (Freeze_Node); - pragma Inline (From_With_Type); + pragma Inline (From_Limited_With); pragma Inline (Full_View); pragma Inline (Generic_Homonym); pragma Inline (Generic_Renamings); @@ -8129,7 +8121,7 @@ package Einfo is pragma Inline (Set_First_Private_Entity); pragma Inline (Set_First_Rep_Item); pragma Inline (Set_Freeze_Node); - pragma Inline (Set_From_With_Type); + pragma Inline (Set_From_Limited_With); pragma Inline (Set_Full_View); pragma Inline (Set_Generic_Homonym); pragma Inline (Set_Generic_Renamings); diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 7458ddf4a80..bd193598b0d 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -1296,14 +1296,14 @@ package body Exp_Attr is -- Handle designated types that come from the limited view if Ekind (Btyp_DDT) = E_Incomplete_Type - and then From_With_Type (Btyp_DDT) + and then From_Limited_With (Btyp_DDT) and then Present (Non_Limited_View (Btyp_DDT)) then Btyp_DDT := Non_Limited_View (Btyp_DDT); elsif Is_Class_Wide_Type (Btyp_DDT) and then Ekind (Etype (Btyp_DDT)) = E_Incomplete_Type - and then From_With_Type (Etype (Btyp_DDT)) + and then From_Limited_With (Etype (Btyp_DDT)) and then Present (Non_Limited_View (Etype (Btyp_DDT))) and then Present (Class_Wide_Type (Non_Limited_View (Etype (Btyp_DDT)))) diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 1b242cc46e9..9d76d2c9f01 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -310,11 +310,11 @@ package body Exp_Ch7 is Defer_Abort : Boolean; Fin_Id : out Entity_Id); -- N may denote an accept statement, block, entry body, package body, - -- package spec, protected body, subprogram body, and a task body. Create + -- package spec, protected body, subprogram body, or a task body. Create -- a procedure which contains finalization calls for all controlled objects -- declared in the declarative or statement region of N. The calls are -- built in reverse order relative to the original declarations. In the - -- case of a tack body, the routine delays the creation of the finalizer + -- case of a task body, the routine delays the creation of the finalizer -- until all statements have been moved to the task body procedure. -- Clean_Stmts may contain additional context-dependent code used to abort -- asynchronous calls or complete tasks (see Build_Cleanup_Statements). diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index c2cbc25c20c..8ba4704328a 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1568,7 +1568,7 @@ package body Exp_Disp is else Actual_Dup := Relocate_Node (Actual); - if From_With_Type (Actual_Typ) then + if From_Limited_With (Actual_Typ) then -- If the type of the actual parameter comes from a limited -- with-clause and the non-limited view is already available @@ -1983,7 +1983,7 @@ package body Exp_Disp is begin if Ekind (Typ) = E_Incomplete_Type then - if From_With_Type (Typ) then + if From_Limited_With (Typ) then Typ := Non_Limited_View (Typ); else Typ := Full_View (Typ); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 1ab8f1e7bda..f9691d726d3 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3549,7 +3549,7 @@ package body Freeze is if Is_Incomplete_Type (F_Type) and then Present (Full_View (F_Type)) - and then not From_With_Type (F_Type) + and then not From_Limited_With (F_Type) then F_Type := Full_View (F_Type); Set_Etype (Formal, F_Type); @@ -3699,7 +3699,7 @@ package body Freeze is Error_Msg_Qual_Level := 0; end if; - if not From_With_Type (F_Type) then + if not From_Limited_With (F_Type) then if Is_Access_Type (F_Type) then F_Type := Designated_Type (F_Type); end if; @@ -3736,7 +3736,7 @@ package body Freeze is if Ekind (R_Type) = E_Incomplete_Type and then Present (Full_View (R_Type)) - and then not From_With_Type (R_Type) + and then not From_Limited_With (R_Type) then R_Type := Full_View (R_Type); Set_Etype (E, R_Type); diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 57dfff171a6..8fa73492667 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -98,7 +98,7 @@ struct incomplete static int defer_incomplete_level = 0; static struct incomplete *defer_incomplete_list; -/* This variable is used to delay expanding From_With_Type types until the +/* This variable is used to delay expanding From_Limited_With types until the end of the spec. */ static struct incomplete *defer_limited_with; @@ -3738,7 +3738,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Whether it comes from a limited with. */ bool is_from_limited_with = (IN (Ekind (gnat_desig_equiv), Incomplete_Kind) - && From_With_Type (gnat_desig_equiv)); + && From_Limited_With (gnat_desig_equiv)); /* The "full view" of the designated type. If this is an incomplete entity from a limited with, treat its non-limited view as the full view. Otherwise, if this is an incomplete or private type, use the @@ -4230,7 +4230,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) we are only annotating types, break circularities here. */ if (type_annotate_only && IN (Ekind (gnat_return_type), Incomplete_Kind) - && From_With_Type (gnat_return_type) + && From_Limited_With (gnat_return_type) && In_Extended_Main_Code_Unit (Non_Limited_View (gnat_return_type)) && !present_gnu_tree (Non_Limited_View (gnat_return_type))) @@ -4343,7 +4343,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) we are only annotating types, break circularities here. */ if (type_annotate_only && IN (Ekind (gnat_param_type), Incomplete_Kind) - && From_With_Type (Etype (gnat_param_type)) + && From_Limited_With (Etype (gnat_param_type)) && In_Extended_Main_Code_Unit (Non_Limited_View (gnat_param_type)) && !present_gnu_tree (Non_Limited_View (gnat_param_type))) @@ -4738,7 +4738,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) full view, whichever is present. This is used in all the tests below. */ Entity_Id full_view - = (IN (kind, Incomplete_Kind) && From_With_Type (gnat_entity)) + = (IN (kind, Incomplete_Kind) && From_Limited_With (gnat_entity)) ? Non_Limited_View (gnat_entity) : Present (Full_View (gnat_entity)) ? Full_View (gnat_entity) @@ -5490,10 +5490,10 @@ is_cplusplus_method (Entity_Id gnat_entity) return false; } -/* Finalize the processing of From_With_Type incomplete types. */ +/* Finalize the processing of From_Limited_With incomplete types. */ void -finalize_from_with_types (void) +finalize_from_limited_with (void) { struct incomplete *p, *next; diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index ca297373d73..832803ccfc3 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -93,8 +93,8 @@ do { \ mark_visited (EXP); \ } while (0) -/* Finalize the processing of From_With_Type incomplete types. */ -extern void finalize_from_with_types (void); +/* Finalize the processing of From_Limited_With incomplete types. */ +extern void finalize_from_limited_with (void); /* Return the equivalent type to be used for GNAT_ENTITY, if it's a kind of type (such E_Task_Type) that has a different type which Gigi diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 9ed804e420f..388345fa7dd 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -5009,7 +5009,7 @@ Compilation_Unit_to_gnu (Node_Id gnat_node) /* Process any pragmas and actions following the unit. */ add_stmt_list (Pragmas_After (Aux_Decls_Node (gnat_node))); add_stmt_list (Actions (Aux_Decls_Node (gnat_node))); - finalize_from_with_types (); + finalize_from_limited_with (); /* Save away what we've made so far and record this potential elaboration procedure. */ @@ -6629,7 +6629,7 @@ gnat_to_gnu (Node_Id gnat_node) Present (gnat_temp); gnat_temp = Next_Formal_With_Extras (gnat_temp)) if (Is_Itype (Etype (gnat_temp)) - && !From_With_Type (Etype (gnat_temp))) + && !From_Limited_With (Etype (gnat_temp))) gnat_to_gnu_entity (Etype (gnat_temp), NULL_TREE, 0); /* Then the result type, set to Standard_Void_Type for procedures. */ @@ -6637,7 +6637,7 @@ gnat_to_gnu (Node_Id gnat_node) Entity_Id gnat_temp_type = Etype (Defining_Entity (Specification (gnat_node))); - if (Is_Itype (gnat_temp_type) && !From_With_Type (gnat_temp_type)) + if (Is_Itype (gnat_temp_type) && !From_Limited_With (gnat_temp_type)) gnat_to_gnu_entity (Etype (gnat_temp_type), NULL_TREE, 0); } diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 4b103039759..d9c693c6548 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -13822,6 +13822,14 @@ version as output. You can specify various style directives via switches; e.g., identifier case conventions, rules of indentation, and comment layout. +Note: A newly-redesigned set of formatting algorithms used by gnatpp +is now available. +To invoke the new experimental formatting algorithms, use the +@option{--pp-new} switch. +The default is @option{--pp-old}; that is, gnatpp uses the old +formatting algorithms by default. +We intend to make @option{--pp-new} the default at some point. + To produce a reformatted file, @command{gnatpp} generates and uses the ASIS tree for the input source and thus requires the input to be syntactically and semantically legal. @@ -14430,6 +14438,14 @@ Display Copyright and version, then exit disregarding all other options. @cindex @option{--help} @command{gnatpp} Display usage, then exit disregarding all other options. +@item --pp-new +@cindex @option{--pp-new} @command{gnatpp} +Use the new experimental formatting algorithms. + +@item --pp-old +@cindex @option{--pp-old} @command{gnatpp} +Use the old formatting algorithms. This is the default. + @item ^-files @var{filename}^/FILES=@var{filename}^ @cindex @option{^-files^/FILES^} (@code{gnatpp}) Take the argument source files from the specified file. This file should be an diff --git a/gcc/ada/itypes.adb b/gcc/ada/itypes.adb index e9a86b411ae..20915bc42c3 100644 --- a/gcc/ada/itypes.adb +++ b/gcc/ada/itypes.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -105,7 +105,7 @@ package body Itypes is Set_Etype (I_Typ, Base_Type (T)); Set_Depends_On_Private (I_Typ, Depends_On_Private (T)); Set_Is_Public (I_Typ, Is_Public (T)); - Set_From_With_Type (I_Typ, From_With_Type (T)); + Set_From_Limited_With (I_Typ, From_Limited_With (T)); Set_Is_Access_Constant (I_Typ, Is_Access_Constant (T)); Set_Is_Generic_Type (I_Typ, Is_Generic_Type (T)); Set_Is_Volatile (I_Typ, Is_Volatile (T)); diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 55fe37812ce..ff49104e066 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2013, 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- -- @@ -2388,7 +2388,7 @@ package body Layout is -- If we only have a limited view of the type, see whether the -- non-limited view is available. - if From_With_Type (Designated_Type (E)) + if From_Limited_With (Designated_Type (E)) and then Ekind (Designated_Type (E)) = E_Incomplete_Type and then Present (Non_Limited_View (Designated_Type (E))) then diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index cb5278cde7b..f794162e20b 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -282,7 +282,7 @@ package body Lib.Writ is end if; else - Set_From_With_Type (Cunit_Entity (Unum)); + Set_From_Limited_With (Cunit_Entity (Unum)); end if; if Implicit_With (Unum) /= Yes then @@ -810,7 +810,7 @@ package body Lib.Writ is Write_Info_Initiate ('Z'); elsif Ekind (Cunit_Entity (Unum)) = E_Package - and then From_With_Type (Cunit_Entity (Unum)) + and then From_Limited_With (Cunit_Entity (Unum)) then Write_Info_Initiate ('Y'); @@ -878,7 +878,7 @@ package body Lib.Writ is end if; if Ekind (Cunit_Entity (Unum)) = E_Package - and then From_With_Type (Cunit_Entity (Unum)) + and then From_Limited_With (Cunit_Entity (Unum)) then null; else @@ -960,7 +960,7 @@ package body Lib.Writ is for Unum in Units.First .. Last_Unit loop if Cunit_Entity (Unum) = Empty - or else not From_With_Type (Cunit_Entity (Unum)) + or else not From_Limited_With (Cunit_Entity (Unum)) then Num_Sdep := Num_Sdep + 1; Sdep_Table (Num_Sdep) := Unum; diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index 166a9e829c0..4a6f0533eb4 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -4708,7 +4708,9 @@ to be used to retrieve information about the predefined path; for example, @item @b{VCS_Kind}: single Value is a string used to specify the Version Control System (VCS) to be used -for this project, for example CVS, RCS, ClearCase or Perforce. +for this project, for example "Subversion", "ClearCase". If the +value is set to "Auto", the IDE will try to detect the actual VCS used +on the list of supported ones. @item @b{VCS_File_Check}: single diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 22abb9a581f..75c4c5a5969 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -760,7 +760,7 @@ package body Rtsfind is -- a real semantic dependence when the purpose of the limited_with -- is precisely to avoid such. - if From_With_Type (Cunit_Entity (U.Unum)) then + if From_Limited_With (Cunit_Entity (U.Unum)) then null; else @@ -1120,7 +1120,7 @@ package body Rtsfind is -- only has a limited view, scan the corresponding list of -- incomplete types. - if From_With_Type (U.Entity) then + if From_Limited_With (U.Entity) then Pkg_Ent := First_Entity (Limited_View (U.Entity)); else Pkg_Ent := First_Entity (U.Entity); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 177c3de74fa..5234d47db6e 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1636,7 +1636,7 @@ package body Sem_Attr is Typ := Etype (E); - if From_With_Type (Typ) then + if From_Limited_With (Typ) then Error_Attr_P ("prefix of % attribute cannot be an incomplete type"); @@ -1655,7 +1655,7 @@ package body Sem_Attr is -- entities may occur in subprogram formals. if Is_Incomplete_Type (Typ) - and then From_With_Type (Typ) + and then From_Limited_With (Typ) and then Present (Non_Limited_View (Typ)) and then Is_Legal_Shadow_Entity_In_Body (Typ) then @@ -9705,7 +9705,7 @@ package body Sem_Attr is -- use of it. If it is an incomplete subtype, use the base type -- in any case. - if From_With_Type (Des_Btyp) + if From_Limited_With (Des_Btyp) and then Present (Non_Limited_View (Des_Btyp)) then Des_Btyp := Non_Limited_View (Des_Btyp); diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 5c2b5df89b6..4e6fc1c7c2e 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -91,7 +91,7 @@ package body Sem_Aux is elsif Is_Class_Wide_Type (Typ) and then Is_Incomplete_Type (Etype (Typ)) - and then From_With_Type (Etype (Typ)) + and then From_Limited_With (Etype (Typ)) and then Present (Non_Limited_View (Etype (Typ))) then return Class_Wide_Type (Non_Limited_View (Etype (Typ))); diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 1c9fd26bbb9..78520f8b0a1 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -3897,7 +3897,7 @@ package body Sem_Ch10 is and then Ekind (Defining_Identifier (Decl)) = E_Incomplete_Subtype and then - From_With_Type (Defining_Identifier (Decl)) + From_Limited_With (Defining_Identifier (Decl)) then Def_Id := Defining_Identifier (Decl); Non_Lim_View := Non_Limited_View (Def_Id); @@ -5076,7 +5076,7 @@ package body Sem_Ch10 is end if; Set_Entity (Name (N), P); - Set_From_With_Type (P); + Set_From_Limited_With (P); end Install_Limited_Withed_Unit; ------------------------- @@ -5192,7 +5192,7 @@ package body Sem_Ch10 is -- tions on the use of package entities. if Ekind (Uname) = E_Package then - Set_From_With_Type (Uname, False); + Set_From_Limited_With (Uname, False); end if; -- Ada 2005 (AI-377): it is illegal for a with_clause to name a child @@ -5379,328 +5379,262 @@ package body Sem_Ch10 is ------------------------- procedure Build_Limited_Views (N : Node_Id) is + Nam : constant Node_Id := Name (N); Unum : constant Unit_Number_Type := Get_Source_Unit (Library_Unit (N)); - P : constant Entity_Id := Cunit_Entity (Unum); - - Spec : Node_Id; -- To denote a package specification - Lim_Typ : Entity_Id; -- To denote shadow entities - Comp_Typ : Entity_Id; -- To denote real entities - - Lim_Header : Entity_Id; -- Package entity - Last_Lim_E : Entity_Id := Empty; -- Last limited entity built - Last_Pub_Lim_E : Entity_Id; -- To set the first private entity - - procedure Decorate_Incomplete_Type (E : Entity_Id; Scop : Entity_Id); - -- Add attributes of an incomplete type to a shadow entity. The same - -- attributes are placed on the real entity, so that gigi receives - -- a consistent view. - - procedure Decorate_Package_Specification (P : Entity_Id); - -- Add attributes of a package entity to the entity in a package - -- declaration - - procedure Decorate_Tagged_Type - (Loc : Source_Ptr; - T : Entity_Id; - Scop : Entity_Id; - Mark : Boolean := False); - -- Set basic attributes of tagged type T, including its class-wide type. - -- The parameters Loc, Scope are used to decorate the class-wide type. - -- Use flag Mark to label the class-wide type as Materialize_Entity. - - procedure Build_Chain (Scope : Entity_Id; First_Decl : Node_Id); - -- Construct list of shadow entities and attach it to entity of - -- package that is mentioned in a limited_with clause. - - function New_Internal_Shadow_Entity - (Kind : Entity_Kind; - Sloc_Value : Source_Ptr; - Id_Char : Character) return Entity_Id; - -- Build a new internal entity and append it to the list of shadow - -- entities available through the limited-header - - ----------------- - -- Build_Chain -- - ----------------- - - procedure Build_Chain (Scope : Entity_Id; First_Decl : Node_Id) is - Analyzed_Unit : constant Boolean := Analyzed (Cunit (Unum)); - Is_Tagged : Boolean; - Decl : Node_Id; + Pack : constant Entity_Id := Cunit_Entity (Unum); + + Shadow_Pack : Entity_Id; + -- The corresponding shadow entity of the withed package. This entity + -- offers incomplete views of all types and visible packages declared + -- within. + + Last_Shadow : Entity_Id := Empty; + -- The last shadow entity created by routine Build_Shadow_Entity + + function Build_Shadow_Entity + (Ent : Entity_Id; + Scop : Entity_Id; + Is_Tagged : Boolean := False) return Entity_Id; + -- Create a shadow entity that hides Ent and offers an incomplete view + -- of Ent. Scop is the proper scope. Flag Is_Tagged should be set when + -- Ent is a tagged type. The generated entity is added to Lim_Header. + -- This routine updates the value of Last_Shadow. + + procedure Decorate_Package (Ent : Entity_Id; Scop : Entity_Id); + -- Perform minimal decoration of a package or its corresponding shadow + -- entity denoted by Ent. Scop is the proper scope. + + procedure Decorate_Type + (Ent : Entity_Id; + Scop : Entity_Id; + Is_Tagged : Boolean := False; + Materialize : Boolean := False); + -- Perform minimal decoration of a type or its corresponding shadow + -- entity denoted by Ent. Scop is the proper scope. Flag Is_Tagged + -- should be set when Ent is a tagged type. Flag Materialize should be + -- set when Ent is a tagged type and its class-wide type needs to appear + -- in the tree. + + procedure Process_Declarations (Decls : List_Id; Scop : Entity_Id); + -- Inspect declarative list Decls and create shadow entities for all + -- types and packages encountered. Scop is the proper scope. + + ------------------------- + -- Build_Shadow_Entity -- + ------------------------- + + function Build_Shadow_Entity + (Ent : Entity_Id; + Scop : Entity_Id; + Is_Tagged : Boolean := False) return Entity_Id + is + Shadow : constant Entity_Id := Make_Temporary (Sloc (Ent), 'Z'); begin - Decl := First_Decl; - while Present (Decl) loop + -- The shadow entity must share the same name and parent as the + -- entity it hides. - -- For each library_package_declaration in the environment, there - -- is an implicit declaration of a *limited view* of that library - -- package. The limited view of a package contains: - - -- * For each nested package_declaration, a declaration of the - -- limited view of that package, with the same defining- - -- program-unit name. - - -- * For each type_declaration in the visible part, an incomplete - -- type-declaration with the same defining_identifier, whose - -- completion is the type_declaration. If the type_declaration - -- is tagged, then the incomplete_type_declaration is tagged - -- incomplete. - - -- The partial view is tagged if the declaration has the - -- explicit keyword, or else if it is a type extension, both - -- of which can be ascertained syntactically. - - if Nkind (Decl) = N_Full_Type_Declaration then - Is_Tagged := - (Nkind (Type_Definition (Decl)) = N_Record_Definition - and then Tagged_Present (Type_Definition (Decl))) - or else - (Nkind (Type_Definition (Decl)) = N_Derived_Type_Definition - and then - Present - (Record_Extension_Part (Type_Definition (Decl)))); + Set_Chars (Shadow, Chars (Ent)); + Set_Parent (Shadow, Parent (Ent)); + Set_Ekind (Shadow, Ekind (Ent)); + Set_Is_Internal (Shadow); + Set_From_Limited_With (Shadow); - Comp_Typ := Defining_Identifier (Decl); + -- Add the new shadow entity to the limited view of the package - if not Analyzed_Unit then - if Is_Tagged then - Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope, True); - else - Decorate_Incomplete_Type (Comp_Typ, Scope); - end if; - end if; + Last_Shadow := Shadow; + Append_Entity (Shadow, Shadow_Pack); - -- Create shadow entity for type + if Is_Type (Ent) then + Decorate_Type (Shadow, Scop, Is_Tagged); - Lim_Typ := - New_Internal_Shadow_Entity - (Kind => Ekind (Comp_Typ), - Sloc_Value => Sloc (Comp_Typ), - Id_Char => 'Z'); + if Is_Incomplete_Or_Private_Type (Ent) then + Set_Private_Dependents (Shadow, New_Elmt_List); + end if; - Set_Chars (Lim_Typ, Chars (Comp_Typ)); - Set_Parent (Lim_Typ, Parent (Comp_Typ)); - Set_From_With_Type (Lim_Typ); + Set_Non_Limited_View (Shadow, Ent); - if Is_Tagged then - Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope); - else - Decorate_Incomplete_Type (Lim_Typ, Scope); - end if; + elsif Ekind (Ent) = E_Package then + Decorate_Package (Shadow, Scop); + end if; - Set_Non_Limited_View (Lim_Typ, Comp_Typ); - Set_Private_Dependents (Lim_Typ, New_Elmt_List); + return Shadow; + end Build_Shadow_Entity; - elsif Nkind_In (Decl, N_Private_Type_Declaration, - N_Incomplete_Type_Declaration, - N_Task_Type_Declaration, - N_Protected_Type_Declaration) - then - Comp_Typ := Defining_Identifier (Decl); + ---------------------- + -- Decorate_Package -- + ---------------------- - Is_Tagged := - Nkind_In (Decl, N_Private_Type_Declaration, - N_Incomplete_Type_Declaration) - and then Tagged_Present (Decl); + procedure Decorate_Package (Ent : Entity_Id; Scop : Entity_Id) is + begin + Set_Ekind (Ent, E_Package); + Set_Etype (Ent, Standard_Void_Type); + Set_Scope (Ent, Scop); + end Decorate_Package; + + ------------------- + -- Decorate_Type -- + ------------------- + + procedure Decorate_Type + (Ent : Entity_Id; + Scop : Entity_Id; + Is_Tagged : Boolean := False; + Materialize : Boolean := False) + is + CW_Typ : Entity_Id; - if not Analyzed_Unit then - if Is_Tagged then - Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope, True); - else - Decorate_Incomplete_Type (Comp_Typ, Scope); - end if; - end if; + begin + -- An unanalyzed type or a shadow entity of a type is treated as an + -- incomplete type. + + Set_Ekind (Ent, E_Incomplete_Type); + Set_Etype (Ent, Ent); + Set_Scope (Ent, Scop); + Set_Is_First_Subtype (Ent); + Set_Stored_Constraint (Ent, No_Elist); + Set_Full_View (Ent, Empty); + Init_Size_Align (Ent); + + -- A tagged type and its corresponding shadow entity share one common + -- class-wide type. + + if Is_Tagged then + Set_Is_Tagged_Type (Ent); + + if No (Class_Wide_Type (Ent)) then + CW_Typ := + New_External_Entity + (E_Void, Scope (Ent), Sloc (Ent), Ent, 'C', 0, 'T'); + + Set_Class_Wide_Type (Ent, CW_Typ); + + -- Set parent to be the same as the parent of the tagged type. + -- We need a parent field set, and it is supposed to point to + -- the declaration of the type. The tagged type declaration + -- essentially declares two separate types, the tagged type + -- itself and the corresponding class-wide type, so it is + -- reasonable for the parent fields to point to the declaration + -- in both cases. + + Set_Parent (CW_Typ, Parent (Ent)); + + Set_Ekind (CW_Typ, E_Class_Wide_Type); + Set_Etype (CW_Typ, Ent); + Set_Scope (CW_Typ, Scop); + Set_Is_Tagged_Type (CW_Typ); + Set_Is_First_Subtype (CW_Typ); + Init_Size_Align (CW_Typ); + Set_Has_Unknown_Discriminants (CW_Typ); + Set_Class_Wide_Type (CW_Typ, CW_Typ); + Set_Equivalent_Type (CW_Typ, Empty); + Set_From_Limited_With (CW_Typ, From_Limited_With (Ent)); + Set_Materialize_Entity (CW_Typ, Materialize); + end if; + end if; + end Decorate_Type; - Lim_Typ := - New_Internal_Shadow_Entity - (Kind => Ekind (Comp_Typ), - Sloc_Value => Sloc (Comp_Typ), - Id_Char => 'Z'); + -------------------------- + -- Process_Declarations -- + -------------------------- - Set_Chars (Lim_Typ, Chars (Comp_Typ)); - Set_Parent (Lim_Typ, Parent (Comp_Typ)); - Set_From_With_Type (Lim_Typ); + procedure Process_Declarations (Decls : List_Id; Scop : Entity_Id) is + Is_Analyzed : constant Boolean := Analyzed (Cunit (Unum)); + Is_Tagged : Boolean; + Decl : Node_Id; + Def : Node_Id; + Pack : Entity_Id; + Shadow : Entity_Id; + Typ : Entity_Id; - if Is_Tagged then - Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope); - else - Decorate_Incomplete_Type (Lim_Typ, Scope); - end if; + begin + -- Inspect the declarative list, looking for type declarations and + -- nested packages. - Set_Non_Limited_View (Lim_Typ, Comp_Typ); + Decl := First (Decls); + while Present (Decl) loop - -- Initialize Private_Depedents, so the field has the proper - -- type, even though the list will remain empty. + -- Types - Set_Private_Dependents (Lim_Typ, New_Elmt_List); + if Nkind_In (Decl, N_Full_Type_Declaration, + N_Incomplete_Type_Declaration, + N_Private_Extension_Declaration, + N_Private_Type_Declaration, + N_Protected_Type_Declaration, + N_Task_Type_Declaration) + then + Typ := Defining_Entity (Decl); - elsif Nkind (Decl) = N_Private_Extension_Declaration then - Comp_Typ := Defining_Identifier (Decl); + -- Determine whether the type is tagged. Note that packages + -- included via a limited with clause are not always analyzed, + -- hence the tree lookup rather than the use of attribute + -- Is_Tagged_Type. - if not Analyzed_Unit then - Decorate_Tagged_Type (Sloc (Decl), Comp_Typ, Scope, True); - end if; + if Nkind (Decl) = N_Full_Type_Declaration then + Def := Type_Definition (Decl); - -- Create shadow entity for type + Is_Tagged := + (Nkind (Def) = N_Record_Definition + and then Tagged_Present (Def)) + or else + (Nkind (Def) = N_Derived_Type_Definition + and then Present (Record_Extension_Part (Def))); - Lim_Typ := - New_Internal_Shadow_Entity - (Kind => Ekind (Comp_Typ), - Sloc_Value => Sloc (Comp_Typ), - Id_Char => 'Z'); + elsif Nkind_In (Decl, N_Incomplete_Type_Declaration, + N_Private_Type_Declaration) + then + Is_Tagged := Tagged_Present (Decl); - Set_Chars (Lim_Typ, Chars (Comp_Typ)); - Set_Parent (Lim_Typ, Parent (Comp_Typ)); - Set_From_With_Type (Lim_Typ); + elsif Nkind (Decl) = N_Private_Extension_Declaration then + Is_Tagged := True; - Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope); - Set_Non_Limited_View (Lim_Typ, Comp_Typ); + else + Is_Tagged := False; + end if; - elsif Nkind (Decl) = N_Package_Declaration then + -- Perform minor decoration when the withed package has not + -- been analyzed. - -- Local package + if not Is_Analyzed then + Decorate_Type (Typ, Scop, Is_Tagged, True); + end if; - declare - Spec : constant Node_Id := Specification (Decl); + -- Create a shadow entity that hides the type and offers an + -- incomplete view of the said type. - begin - Comp_Typ := Defining_Unit_Name (Spec); + Shadow := Build_Shadow_Entity (Typ, Scop, Is_Tagged); - if not Analyzed (Cunit (Unum)) then - Decorate_Package_Specification (Comp_Typ); - Set_Scope (Comp_Typ, Scope); - end if; + -- Packages + + elsif Nkind (Decl) = N_Package_Declaration then + Pack := Defining_Entity (Decl); - Lim_Typ := - New_Internal_Shadow_Entity - (Kind => Ekind (Comp_Typ), - Sloc_Value => Sloc (Comp_Typ), - Id_Char => 'Z'); + -- Perform minor decoration when the withed package has not + -- been analyzed. - Decorate_Package_Specification (Lim_Typ); - Set_Scope (Lim_Typ, Scope); + if not Is_Analyzed then + Decorate_Package (Pack, Scop); + end if; - Set_Chars (Lim_Typ, Chars (Comp_Typ)); - Set_Parent (Lim_Typ, Parent (Comp_Typ)); - Set_From_With_Type (Lim_Typ); + -- Create a shadow entity that offers a limited view of all + -- visible types declared within. - -- Note: The non_limited_view attribute is not used - -- for local packages. + Shadow := Build_Shadow_Entity (Pack, Scop); - Build_Chain - (Scope => Lim_Typ, - First_Decl => First (Visible_Declarations (Spec))); - end; + Process_Declarations + (Decls => Visible_Declarations (Specification (Decl)), + Scop => Shadow); end if; Next (Decl); end loop; - end Build_Chain; - - ------------------------------ - -- Decorate_Incomplete_Type -- - ------------------------------ - - procedure Decorate_Incomplete_Type (E : Entity_Id; Scop : Entity_Id) is - begin - Set_Ekind (E, E_Incomplete_Type); - Set_Scope (E, Scop); - Set_Etype (E, E); - Set_Is_First_Subtype (E, True); - Set_Stored_Constraint (E, No_Elist); - Set_Full_View (E, Empty); - Init_Size_Align (E); - end Decorate_Incomplete_Type; - - -------------------------- - -- Decorate_Tagged_Type -- - -------------------------- - - procedure Decorate_Tagged_Type - (Loc : Source_Ptr; - T : Entity_Id; - Scop : Entity_Id; - Mark : Boolean := False) - is - CW : Entity_Id; + end Process_Declarations; - begin - Decorate_Incomplete_Type (T, Scop); - Set_Is_Tagged_Type (T); - - -- Build corresponding class_wide type, if not previously done - - -- Note: The class-wide entity is shared by the limited-view - -- and the full-view. - - if No (Class_Wide_Type (T)) then - CW := New_External_Entity (E_Void, Scope (T), Loc, T, 'C', 0, 'T'); - - -- Set parent to be the same as the parent of the tagged type. - -- We need a parent field set, and it is supposed to point to - -- the declaration of the type. The tagged type declaration - -- essentially declares two separate types, the tagged type - -- itself and the corresponding class-wide type, so it is - -- reasonable for the parent fields to point to the declaration - -- in both cases. - - Set_Parent (CW, Parent (T)); - - -- Set remaining fields of classwide type - - Set_Ekind (CW, E_Class_Wide_Type); - Set_Etype (CW, T); - Set_Scope (CW, Scop); - Set_Is_Tagged_Type (CW); - Set_Is_First_Subtype (CW, True); - Init_Size_Align (CW); - Set_Has_Unknown_Discriminants (CW, True); - Set_Class_Wide_Type (CW, CW); - Set_Equivalent_Type (CW, Empty); - Set_From_With_Type (CW, From_With_Type (T)); - Set_Materialize_Entity (CW, Mark); - - -- Link type to its class-wide type - - Set_Class_Wide_Type (T, CW); - end if; - end Decorate_Tagged_Type; - - ------------------------------------ - -- Decorate_Package_Specification -- - ------------------------------------ - - procedure Decorate_Package_Specification (P : Entity_Id) is - begin - -- Place only the most basic attributes - - Set_Ekind (P, E_Package); - Set_Etype (P, Standard_Void_Type); - end Decorate_Package_Specification; - - -------------------------------- - -- New_Internal_Shadow_Entity -- - -------------------------------- - - function New_Internal_Shadow_Entity - (Kind : Entity_Kind; - Sloc_Value : Source_Ptr; - Id_Char : Character) return Entity_Id - is - E : constant Entity_Id := Make_Temporary (Sloc_Value, Id_Char); - - begin - Set_Ekind (E, Kind); - Set_Is_Internal (E, True); - - if Kind in Type_Kind then - Init_Size_Align (E); - end if; + -- Local variables - Append_Entity (E, Lim_Header); - Last_Lim_E := E; - return E; - end New_Internal_Shadow_Entity; + Last_Public_Shadow : Entity_Id := Empty; + Private_Shadow : Entity_Id; + Spec : Node_Id; -- Start of processing for Build_Limited_Views @@ -5716,49 +5650,51 @@ package body Sem_Ch10 is null; when N_Subprogram_Declaration => - Error_Msg_N ("subprograms not allowed in " - & "limited with_clauses", N); + Error_Msg_N ("subprograms not allowed in limited with_clauses", N); return; when N_Generic_Package_Declaration | N_Generic_Subprogram_Declaration => - Error_Msg_N ("generics not allowed in " - & "limited with_clauses", N); + Error_Msg_N ("generics not allowed in limited with_clauses", N); return; when N_Generic_Instantiation => - Error_Msg_N ("generic instantiations not allowed in " - & "limited with_clauses", N); + Error_Msg_N + ("generic instantiations not allowed in limited with_clauses", + N); return; when N_Generic_Renaming_Declaration => - Error_Msg_N ("generic renamings not allowed in " - & "limited with_clauses", N); + Error_Msg_N + ("generic renamings not allowed in limited with_clauses", N); return; when N_Subprogram_Renaming_Declaration => - Error_Msg_N ("renamed subprograms not allowed in " - & "limited with_clauses", N); + Error_Msg_N + ("renamed subprograms not allowed in limited with_clauses", N); return; when N_Package_Renaming_Declaration => - Error_Msg_N ("renamed packages not allowed in " - & "limited with_clauses", N); + Error_Msg_N + ("renamed packages not allowed in limited with_clauses", N); return; when others => raise Program_Error; end case; - -- The limited unit is not analyzed but the with clause must be - -- minimally decorated so that checks on unused with clause also work - -- with limited with clauses. + -- The withed unit may not be analyzed, but the with calause itself + -- must be minimally decorated. This ensures that the checks on unused + -- with clauses also process limieted withs. + + Set_Ekind (Pack, E_Package); + Set_Etype (Pack, Standard_Void_Type); - if Is_Entity_Name (Name (N)) then - Set_Entity (Name (N), P); + if Is_Entity_Name (Nam) then + Set_Entity (Nam, Pack); - elsif Nkind (Name (N)) = N_Selected_Component then - Set_Entity (Selector_Name (Name (N)), P); + elsif Nkind (Nam) = N_Selected_Component then + Set_Entity (Selector_Name (Nam), Pack); end if; -- Check if the chain is already built @@ -5769,41 +5705,37 @@ package body Sem_Ch10 is return; end if; - Set_Ekind (P, E_Package); - - -- Build the header of the limited_view - - Lim_Header := Make_Temporary (Sloc (N), 'Z'); - Set_Ekind (Lim_Header, E_Package); - Set_Is_Internal (Lim_Header); - Set_Limited_View (P, Lim_Header); + -- Create the shadow package wich hides the withed unit and provides + -- incomplete view of all types and packages declared within. - -- Create the auxiliary chain. All the shadow entities are appended to - -- the list of entities of the limited-view header + Shadow_Pack := Make_Temporary (Sloc (N), 'Z'); + Set_Ekind (Shadow_Pack, E_Package); + Set_Is_Internal (Shadow_Pack); + Set_Limited_View (Pack, Shadow_Pack); - Build_Chain - (Scope => P, - First_Decl => First (Visible_Declarations (Spec))); + -- Inspect the visible declarations of the withed unit and create shadow + -- entities that hide existing types and packages. - -- Save the last built shadow entity. It is needed later to set the - -- reference to the first shadow entity in the private part + Process_Declarations + (Decls => Visible_Declarations (Spec), + Scop => Pack); - Last_Pub_Lim_E := Last_Lim_E; + Last_Public_Shadow := Last_Shadow; - -- Ada 2005 (AI-262): Add the limited view of the private declarations - -- Required to give support to limited-private-with clauses + -- Ada 2005 (AI-262): Build the limited view of the private declarations + -- to accomodate limited private with clauses. - Build_Chain (Scope => P, - First_Decl => First (Private_Declarations (Spec))); + Process_Declarations + (Decls => Private_Declarations (Spec), + Scop => Pack); - if Last_Pub_Lim_E /= Empty then - Set_First_Private_Entity - (Lim_Header, Next_Entity (Last_Pub_Lim_E)); + if Present (Last_Public_Shadow) then + Private_Shadow := Next_Entity (Last_Public_Shadow); else - Set_First_Private_Entity - (Lim_Header, First_Entity (P)); + Private_Shadow := First_Entity (Shadow_Pack); end if; + Set_First_Private_Entity (Shadow_Pack, Private_Shadow); Set_Limited_View_Installed (Spec); end Build_Limited_Views; @@ -6118,7 +6050,7 @@ package body Sem_Ch10 is -- Indicate that the limited view of the package is not installed - Set_From_With_Type (P, False); + Set_From_Limited_With (P, False); Set_Limited_View_Installed (N, False); end Remove_Limited_With_Clause; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 2ae6418baf7..4ce3fd69f9d 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3477,7 +3477,7 @@ package body Sem_Ch12 is -- Ada 2005 (AI-50217): Cannot use instance in limited with_clause - if From_With_Type (Gen_Unit) then + if From_Limited_With (Gen_Unit) then Error_Msg_N ("cannot instantiate a limited withed package", Gen_Id); else @@ -10610,7 +10610,7 @@ package body Sem_Ch12 is -- with clause, in which case retrieve the non-limited view. This -- applies to incomplete types as well as to class-wide types. - if From_With_Type (Desig_Act) then + if From_Limited_With (Desig_Act) then Desig_Act := Available_View (Desig_Act); end if; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 6744484da38..4e3fcacedc3 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -10208,7 +10208,7 @@ package body Sem_Ch13 is -- Exclude imported types, which may be frozen if they appear in a -- representation clause for a local type. - and then not From_With_Type (T) + and then not From_Limited_With (T) -- Exclude generated entities (not coming from source). The common -- case is when we generate a renaming which prematurely freezes the diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 8074775dfd0..50ef808e013 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -896,7 +896,7 @@ package body Sem_Ch3 is -- (which is declared elsewhere in some other scope). if Ekind (Desig_Type) = E_Incomplete_Type - and then not From_With_Type (Desig_Type) + and then not From_Limited_With (Desig_Type) and then Is_Overloadable (Current_Scope) then Append_Elmt (Current_Scope, Private_Dependents (Desig_Type)); @@ -950,7 +950,7 @@ package body Sem_Ch3 is -- generic formal, because no use of it will reach the backend. elsif Nkind (Related_Nod) = N_Function_Specification - and then not From_With_Type (Desig_Type) + and then not From_Limited_With (Desig_Type) and then not Is_Generic_Type (Desig_Type) then if Present (Enclosing_Prot_Type) then @@ -1131,7 +1131,7 @@ package body Sem_Ch3 is Scope_Id => Current_Scope)); else - if From_With_Type (Typ) then + if From_Limited_With (Typ) then -- AI05-151: Incomplete types are allowed in all basic -- declarations, including access to subprograms. @@ -1360,7 +1360,7 @@ package body Sem_Ch3 is -- If the type has appeared already in a with_type clause, it is frozen -- and the pointer size is already set. Else, initialize. - if not From_With_Type (T) then + if not From_Limited_With (T) then Init_Size_Align (T); end if; @@ -2546,7 +2546,7 @@ package body Sem_Ch3 is -- finalization list at the point the access type is frozen, to -- prevent unsatisfied references at link time. - if not From_With_Type (T) or else Is_Access_Type (T) then + if not From_Limited_With (T) or else Is_Access_Type (T) then Set_Has_Delayed_Freeze (T); end if; end; @@ -4466,11 +4466,11 @@ package body Sem_Ch3 is -- Ada 2005 (AI-412): Decorate an incomplete subtype of an -- incomplete type visible through a limited with clause. - if From_With_Type (T) + if From_Limited_With (T) and then Present (Non_Limited_View (T)) then - Set_From_With_Type (Id); - Set_Non_Limited_View (Id, Non_Limited_View (T)); + Set_From_Limited_With (Id); + Set_Non_Limited_View (Id, Non_Limited_View (T)); -- Ada 2005 (AI-412): Add the regular incomplete subtype -- to the private dependents of the original incomplete @@ -11933,13 +11933,12 @@ package body Sem_Ch3 is -- incomplete type or imported via a limited with clause. if Has_Discriminants (T) - or else - (From_With_Type (T) - and then Present (Non_Limited_View (T)) - and then Nkind (Parent (Non_Limited_View (T))) = - N_Full_Type_Declaration - and then Present (Discriminant_Specifications - (Parent (Non_Limited_View (T))))) + or else (From_Limited_With (T) + and then Present (Non_Limited_View (T)) + and then Nkind (Parent (Non_Limited_View (T))) = + N_Full_Type_Declaration + and then Present (Discriminant_Specifications + (Parent (Non_Limited_View (T))))) then Error_Msg_N ("(Ada 2005) incomplete subtype may not be constrained", C); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 06a548a4b7c..52aa233746b 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1861,8 +1861,8 @@ package body Sem_Ch4 is -- incomplete type imported through a limited_with clause, -- if the full view is visible. - if From_With_Type (DT) - and then not From_With_Type (Scope (DT)) + if From_Limited_With (DT) + and then not From_Limited_With (Scope (DT)) and then (Is_Immediately_Visible (Scope (DT)) or else @@ -4073,7 +4073,7 @@ package body Sem_Ch4 is -- full view if available. if Is_Incomplete_Type (Prefix_Type) - and then From_With_Type (Prefix_Type) + and then From_Limited_With (Prefix_Type) and then Present (Non_Limited_View (Prefix_Type)) then Prefix_Type := Get_Full_View (Non_Limited_View (Prefix_Type)); @@ -4083,7 +4083,7 @@ package body Sem_Ch4 is end if; elsif Ekind (Prefix_Type) = E_Class_Wide_Type - and then From_With_Type (Prefix_Type) + and then From_Limited_With (Prefix_Type) and then Present (Non_Limited_View (Etype (Prefix_Type))) then Prefix_Type := @@ -4191,7 +4191,7 @@ package body Sem_Ch4 is -- end Pkg; -- Comp is not visible if Nkind (Name) = N_Explicit_Dereference - and then From_With_Type (Etype (Prefix (Name))) + and then From_Limited_With (Etype (Prefix (Name))) and then not Is_Potentially_Use_Visible (Etype (Name)) and then Nkind (Parent (Cunit_Entity (Current_Sem_Unit))) = N_Package_Specification @@ -4644,7 +4644,7 @@ package body Sem_Ch4 is Inc : constant Entity_Id := First_Subtype (Type_To_Use); begin - if From_With_Type (Scope (Type_To_Use)) then + if From_Limited_With (Scope (Type_To_Use)) then Error_Msg_NE ("\limited view of& has no components", N, Inc); @@ -5364,7 +5364,7 @@ package body Sem_Ch4 is -- usage of an entity from the limited view. if not Analyzed (Etype (Actual)) - and then From_With_Type (Etype (Actual)) + and then From_Limited_With (Etype (Actual)) then Error_Msg_Qual_Level := 1; Error_Msg_NE @@ -6525,8 +6525,8 @@ package body Sem_Ch4 is -- incomplete type imported through a limited_with clause, -- if the full view is visible. - if From_With_Type (Typ) - and then not From_With_Type (Scope (Typ)) + if From_Limited_With (Typ) + and then not From_Limited_With (Scope (Typ)) and then (Is_Immediately_Visible (Scope (Typ)) or else @@ -7753,7 +7753,7 @@ package body Sem_Ch4 is -- non-limited view. If still incomplete, retrieve full view. if Ekind (Obj_Type) = E_Incomplete_Type - and then From_With_Type (Obj_Type) + and then From_Limited_With (Obj_Type) then Obj_Type := Get_Full_View (Non_Limited_View (Obj_Type)); end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index fec9ef5cea2..1ad5f2d525e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2500,7 +2500,7 @@ package body Sem_Ch6 is begin if Ekind (Typ) = E_Incomplete_Type - and then From_With_Type (Typ) + and then From_Limited_With (Typ) and then Present (Non_Limited_View (Typ)) then Set_Etype (Id, Non_Limited_View (Typ)); @@ -3058,7 +3058,9 @@ package body Sem_Ch6 is if Ekind (Rtyp) = E_Anonymous_Access_Type then Etyp := Directly_Designated_Type (Rtyp); - if Is_Class_Wide_Type (Etyp) and then From_With_Type (Etyp) then + if Is_Class_Wide_Type (Etyp) + and then From_Limited_With (Etyp) + then Set_Directly_Designated_Type (Etype (Current_Scope), Available_View (Etyp)); end if; @@ -6547,7 +6549,9 @@ package body Sem_Ch6 is then Set_Has_Delayed_Freeze (Designator); - elsif Ekind (T) = E_Incomplete_Type and then From_With_Type (T) then + elsif Ekind (T) = E_Incomplete_Type + and then From_Limited_With (T) + then Set_Has_Delayed_Freeze (Designator); -- AI05-0151: In Ada 2012, Incomplete types can appear in the profile @@ -7711,14 +7715,14 @@ package body Sem_Ch6 is -- access-to-class-wide type in a formal. Both entities designate the -- same type. - if From_With_Type (T1) and then T2 = Available_View (T1) then + if From_Limited_With (T1) and then T2 = Available_View (T1) then return True; - elsif From_With_Type (T2) and then T1 = Available_View (T2) then + elsif From_Limited_With (T2) and then T1 = Available_View (T2) then return True; - elsif From_With_Type (T1) - and then From_With_Type (T2) + elsif From_Limited_With (T1) + and then From_Limited_With (T2) and then Available_View (T1) = Available_View (T2) then return True; @@ -8212,7 +8216,8 @@ package body Sem_Ch6 is -- the designated type comes from the limited view (for back-end -- purposes). - Set_From_With_Type (Formal_Typ, From_With_Type (Result_Subt)); + Set_From_Limited_With + (Formal_Typ, From_Limited_With (Result_Subt)); Layout_Type (Formal_Typ); @@ -10946,7 +10951,7 @@ package body Sem_Ch6 is First_Out_Param : Entity_Id := Empty; -- Used for setting Is_Only_Out_Parameter - function Designates_From_With_Type (Typ : Entity_Id) return Boolean; + function Designates_From_Limited_With (Typ : Entity_Id) return Boolean; -- Determine whether an access type designates a type coming from a -- limited view. @@ -10955,11 +10960,11 @@ package body Sem_Ch6 is -- default has the type of the formal, so we must also check explicitly -- for an access attribute. - ------------------------------- - -- Designates_From_With_Type -- - ------------------------------- + ---------------------------------- + -- Designates_From_Limited_With -- + ---------------------------------- - function Designates_From_With_Type (Typ : Entity_Id) return Boolean is + function Designates_From_Limited_With (Typ : Entity_Id) return Boolean is Desig : Entity_Id := Typ; begin @@ -10972,8 +10977,9 @@ package body Sem_Ch6 is end if; return - Ekind (Desig) = E_Incomplete_Type and then From_With_Type (Desig); - end Designates_From_With_Type; + Ekind (Desig) = E_Incomplete_Type + and then From_Limited_With (Desig); + end Designates_From_Limited_With; --------------------------- -- Is_Class_Wide_Default -- @@ -11031,7 +11037,7 @@ package body Sem_Ch6 is if Is_Tagged_Type (Formal_Type) then if Ekind (Scope (Current_Scope)) = E_Package - and then not From_With_Type (Formal_Type) + and then not From_Limited_With (Formal_Type) and then not Is_Generic_Type (Formal_Type) and then not Is_Class_Wide_Type (Formal_Type) then @@ -11214,7 +11220,7 @@ package body Sem_Ch6 is -- is also class-wide. if Ekind (Formal_Type) = E_Anonymous_Access_Type - and then not Designates_From_With_Type (Formal_Type) + and then not Designates_From_Limited_With (Formal_Type) and then Is_Class_Wide_Default (Default) and then not Is_Class_Wide_Type (Designated_Type (Formal_Type)) then diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 5dde5002cb0..e9f32ede004 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -804,7 +804,7 @@ package body Sem_Ch7 is -- limited with Pkg; -- ERROR -- package Pkg is ... - if From_With_Type (Id) then + if From_Limited_With (Id) then return; end if; @@ -1580,7 +1580,7 @@ package body Sem_Ch7 is E := First_Entity (Spec_Id); while Present (E) loop if Ekind (E) = E_Anonymous_Access_Type - and then From_With_Type (E) + and then From_Limited_With (E) then IR := Make_Itype_Reference (Sloc (P_Body)); Set_Itype (IR, E); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index c82f6491a00..34b52593db5 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4104,7 +4104,7 @@ package body Sem_Ch8 is T := Entity (Id); - if T = Any_Type or else From_With_Type (T) then + if T = Any_Type or else From_Limited_With (T) then null; -- Note that the use_type clause may mention a subtype of the type @@ -5221,7 +5221,7 @@ package body Sem_Ch8 is -- The non-limited view may itself be incomplete, in which case -- get the full view if available. - elsif From_With_Type (Id) + elsif From_Limited_With (Id) and then Is_Type (Id) and then Ekind (Id) = E_Incomplete_Type and then Present (Non_Limited_View (Id)) @@ -5519,8 +5519,8 @@ package body Sem_Ch8 is -- Ada 2005 (AI-50217): Check usage of entities in limited withed units - if Ekind (P_Name) = E_Package and then From_With_Type (P_Name) then - if From_With_Type (Id) + if Ekind (P_Name) = E_Package and then From_Limited_With (P_Name) then + if From_Limited_With (Id) or else Is_Type (Id) or else Ekind (Id) = E_Package then @@ -6328,7 +6328,7 @@ package body Sem_Ch8 is -- tagged if the type itself has an untagged incomplete -- type view in its package. - if From_With_Type (T) + if From_Limited_With (T) and then not Is_Tagged_Type (Available_View (T)) then Error_Msg_N @@ -6519,7 +6519,7 @@ package body Sem_Ch8 is -- Ada 2005 (AI-251, AI-50217): Handle interfaces visible through -- limited-with clauses - if From_With_Type (T_Name) + if From_Limited_With (T_Name) and then Ekind (T_Name) in Incomplete_Kind and then Present (Non_Limited_View (T_Name)) and then Is_Interface (Non_Limited_View (T_Name)) @@ -7097,7 +7097,7 @@ package body Sem_Ch8 is or else (Is_Private_Type (T1) and then Has_Discriminants (T1)) or else (Is_Task_Type (T1) and then Has_Discriminants (T1)) or else (Is_Incomplete_Type (T1) - and then From_With_Type (T1) + and then From_Limited_With (T1) and then Present (Non_Limited_View (T1)) and then Is_Record_Type (Get_Full_View (Non_Limited_View (T1)))); @@ -7878,7 +7878,7 @@ package body Sem_Ch8 is -- Ada 2005 (AI-50217): Check restriction - if From_With_Type (P) then + if From_Limited_With (P) then Error_Msg_N ("limited withed package cannot appear in use clause", N); end if; @@ -8201,7 +8201,7 @@ package body Sem_Ch8 is -- a limited view unless we only have a limited view of its enclosing -- package. - elsif From_With_Type (T) and then From_With_Type (Scope (T)) then + elsif From_Limited_With (T) and then From_Limited_With (Scope (T)) then Error_Msg_N ("incomplete type from limited view " & "cannot appear in use clause", Id); diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index 79c1e15037a..233e30168a2 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -2277,6 +2277,12 @@ package body Sem_Dim is Result := No_Rational; end if; + -- Provide minimal semantic information on dimension expressions, + -- even though they have no run-time existence. This is for use by + -- ASIS tools, in particular pretty-printing. + + Set_Entity (N, Standard_Op_Minus); + Set_Etype (N, Standard_Integer); return Result; end Process_Minus; @@ -2302,6 +2308,12 @@ package body Sem_Dim is Result := Left_Rat / Right_Rat; end if; + -- Provide minimal semantic information on dimension expressions, + -- even though they have no run-time existence. This is for use by + -- ASIS tools, in particular pretty-printing. + + Set_Entity (N, Standard_Op_Divide); + Set_Etype (N, Standard_Integer); return Result; end Process_Divide; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 9f80a7dcea1..7b815812a32 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -331,7 +331,7 @@ package body Sem_Disp is -- Ada 2005 (AI-50217) - elsif From_With_Type (Designated_Type (T)) + elsif From_Limited_With (Designated_Type (T)) and then Present (Non_Limited_View (Designated_Type (T))) and then Scope (Designated_Type (T)) = Scope (Subp) then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 0b758a2591d..15b13ffd605 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -17218,6 +17218,14 @@ package body Sem_Prag is Spec_Id : Entity_Id; begin + -- Disable the support for pragma Refined_Pre as its static and + -- runtime semantics are still under heavy design. + + if Pname = Name_Refined_Pre then + Error_Pragma ("pragma % is not supported"); + return; + end if; + Analyze_Refined_Pragma (Spec_Id, Body_Id, Legal); -- Analyze the boolean expression as a "spec expression" diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 9409972ec54..8b610126159 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -9858,7 +9858,7 @@ package body Sem_Res is -- Ada 2005 (AI-217): Handle entities from limited views - if From_With_Type (Opnd) then + if From_Limited_With (Opnd) then Error_Msg_Qual_Level := 99; Error_Msg_NE -- CODEFIX ("missing WITH clause on package &", N, @@ -9867,7 +9867,7 @@ package body Sem_Res is ("type conversions require visibility of the full view", N); - elsif From_With_Type (Target) + elsif From_Limited_With (Target) and then not (Is_Access_Type (Target_Typ) and then Present (Non_Limited_View (Etype (Target)))) @@ -10871,7 +10871,7 @@ package body Sem_Res is -- it to determine whether the conversion is legal. elsif Is_Class_Wide_Type (Opnd_Type) - and then From_With_Type (Opnd_Type) + and then From_Limited_With (Opnd_Type) and then Present (Non_Limited_View (Etype (Opnd_Type))) and then Is_Interface (Non_Limited_View (Etype (Opnd_Type))) then @@ -11346,7 +11346,7 @@ package body Sem_Res is -- Handle the limited view of a type if Is_Incomplete_Type (Desig) - and then From_With_Type (Desig) + and then From_Limited_With (Desig) and then Present (Non_Limited_View (Desig)) then return Available_View (Desig); diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 7239410ab52..8e0fd5fa80d 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -1127,7 +1127,7 @@ package body Sem_Type is then return Covers (Designated_Type (T1), Designated_Type (T2)) or else - (From_With_Type (Designated_Type (T1)) + (From_Limited_With (Designated_Type (T1)) and then Covers (Designated_Type (T2), Designated_Type (T1))); -- A boolean operation on integer literals is compatible with modular @@ -1205,7 +1205,7 @@ package body Sem_Type is -- Ada 2005 (AI-50217): Additional branches to make the shadow entity -- obtained through a limited_with compatible with its real entity. - elsif From_With_Type (T1) then + elsif From_Limited_With (T1) then -- If the expected type is the non-limited view of a type, the -- expression may have the limited view. If that one in turn is @@ -1221,7 +1221,7 @@ package body Sem_Type is return False; end if; - elsif From_With_Type (T2) then + elsif From_Limited_With (T2) then -- If units in the context have Limited_With clauses on each other, -- either type might have a limited view. Checks performed elsewhere diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index a938f0ae344..15e6a641a06 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1445,7 +1445,7 @@ package body Sem_Util is -- Ada 2005 (AI-50217): If the type is available through a limited -- with_clause, verify that its full view has been analyzed. - if From_With_Type (T) + if From_Limited_With (T) and then Present (Non_Limited_View (T)) and then Ekind (Non_Limited_View (T)) /= E_Incomplete_Type then @@ -9150,7 +9150,7 @@ package body Sem_Util is begin return Is_Class_Wide_Type (Typ) - and then (Is_Limited_Type (Typ) or else From_With_Type (Typ)); + and then (Is_Limited_Type (Typ) or else From_Limited_With (Typ)); end Is_Limited_Class_Wide_Type; --------------------------------- @@ -15419,7 +15419,7 @@ package body Sem_Util is ("\\found an access type with designated}!", Expr, Designated_Type (Found_Type)); else - if From_With_Type (Found_Type) then + if From_Limited_With (Found_Type) then Error_Msg_NE ("\\found incomplete}!", Expr, Found_Type); Error_Msg_Qual_Level := 99; Error_Msg_NE -- CODEFIX diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index d9c80de8510..493c5e4f517 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -2434,7 +2434,7 @@ package body Sem_Warn is or else Referenced_As_LHS_Check_Spec (Ent) or else Referenced_As_Out_Parameter_Check_Spec (Ent) or else - (From_With_Type (Ent) + (From_Limited_With (Ent) and then Is_Incomplete_Type (Ent) and then Present (Non_Limited_View (Ent)) and then Referenced (Non_Limited_View (Ent))) |