-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
with Sem_Ch4; use Sem_Ch4;
with Sem_Ch6; use Sem_Ch6;
with Sem_Ch12; use Sem_Ch12;
+with Sem_Ch13; use Sem_Ch13;
+with Sem_Dim; use Sem_Dim;
with Sem_Disp; use Sem_Disp;
with Sem_Dist; use Sem_Dist;
with Sem_Eval; use Sem_Eval;
T := Entity (Subtype_Mark (N));
Analyze (Nam);
+ -- Reject renamings of conversions unless the type is tagged, or
+ -- the conversion is implicit (which can occur for cases of anonymous
+ -- access types in Ada 2012).
+
if Nkind (Nam) = N_Type_Conversion
- and then not Is_Tagged_Type (T)
+ and then Comes_From_Source (Nam)
+ and then not Is_Tagged_Type (T)
then
Error_Msg_N
("renaming of conversion only allowed for tagged types", Nam);
return;
end if;
+ -- Ada 2012 (AI05-149): Reject renaming of an anonymous access object
+ -- when renaming declaration has a named access type. The Ada 2012
+ -- coverage rules allow an anonymous access type in the context of
+ -- an expected named general access type, but the renaming rules
+ -- require the types to be the same. (An exception is when the type
+ -- of the renaming is also an anonymous access type, which can only
+ -- happen due to a renaming created by the expander.)
+
+ if Nkind (Nam) = N_Type_Conversion
+ and then not Comes_From_Source (Nam)
+ and then Ekind (Etype (Expression (Nam))) = E_Anonymous_Access_Type
+ and then Ekind (T) /= E_Anonymous_Access_Type
+ then
+ Wrong_Type (Expression (Nam), T); -- Should we give better error???
+ end if;
+
-- Check that a class-wide object is not being renamed as an object
-- of a specific type. The test for access types is needed to exclude
-- cases where the renamed object is a dynamically tagged access
end if;
Set_Ekind (Id, E_Variable);
- Init_Size_Align (Id);
+
+ -- Initialize the object size and alignment. Note that we used to call
+ -- Init_Size_Align here, but that's wrong for objects which have only
+ -- an Esize, not an RM_Size field!
+
+ Init_Object_Size_Align (Id);
if T = Any_Type or else Etype (Nam) = Any_Type then
return;
end if;
Set_Renamed_Object (Id, Nam);
+ Analyze_Dimension (N);
end Analyze_Object_Renaming;
------------------------------
Statements (Handled_Statement_Sequence (New_Body)));
-- The generated body does not freeze. It is analyzed when the
- -- generated operation is frozen.
+ -- generated operation is frozen. This body is only needed if
+ -- expansion is enabled.
- Append_Freeze_Action (Defining_Entity (New_Decl), New_Body);
+ if Expander_Active then
+ Append_Freeze_Action (Defining_Entity (New_Decl), New_Body);
+ end if;
Result := Defining_Entity (New_Decl);
end if;
-- expanded in subsequent instantiations.
if Is_Actual and then Is_Abstract_Subprogram (Formal_Spec)
- and then Expander_Active
+ and then Full_Expander_Active
then
declare
Stream_Prim : Entity_Id;
elsif not Is_Entity_Name (Nam)
or else not Is_Overloadable (Entity (Nam))
then
- Error_Msg_N ("expect valid subprogram name in renaming", N);
+ -- Do not mention the renaming if it comes from an instance
+
+ if not Is_Actual then
+ Error_Msg_N ("expect valid subprogram name in renaming", N);
+ else
+ Error_Msg_NE ("no visible subprogram for formal&", N, Nam);
+ end if;
+
return;
end if;
if not Is_Actual
and then (Old_S = New_S
- or else (Nkind (Nam) /= N_Expanded_Name
- and then Chars (Old_S) = Chars (New_S)))
+ or else
+ (Nkind (Nam) /= N_Expanded_Name
+ and then Chars (Old_S) = Chars (New_S))
+ or else
+ (Nkind (Nam) = N_Expanded_Name
+ and then Entity (Prefix (Nam)) = Current_Scope
+ and then
+ Chars (Selector_Name (Nam)) = Chars (New_S)))
then
Error_Msg_N ("subprogram cannot rename itself", N);
end if;
("?redundant renaming, entity is directly visible", Name (N));
end if;
+ -- Implementation-defined aspect specifications can appear in a renaming
+ -- declaration, but not language-defined ones. The call to procedure
+ -- Analyze_Aspect_Specifications will take care of this error check.
+
+ if Has_Aspects (N) then
+ Analyze_Aspect_Specifications (N, New_S);
+ end if;
+
Ada_Version := Save_AV;
Ada_Version_Explicit := Save_AV_Exp;
end Analyze_Subprogram_Renaming;
-- type is still not frozen). We exclude from this processing generic
-- formal subprograms found in instantiations and AST_Entry renamings.
- -- We must exclude VM targets because entity AST_Handler is defined in
- -- package System.Aux_Dec which is not available in those platforms.
+ -- We must exclude VM targets and restricted run-time libraries because
+ -- entity AST_Handler is defined in package System.Aux_Dec which is not
+ -- available in those platforms. Note that we cannot use the function
+ -- Restricted_Profile (instead of Configurable_Run_Time_Mode) because
+ -- the ZFP run-time library is not defined as a profile, and we do not
+ -- want to deal with AST_Handler in ZFP mode.
if VM_Target = No_VM
+ and then not Configurable_Run_Time_Mode
and then not Present (Corresponding_Formal_Spec (N))
and then Etype (Nam) /= RTE (RE_AST_Handler)
then
-- is completed in the current scope, and not for a limited
-- view of a type.
- if not Is_Tagged_Type (T)
- and then Ada_Version >= Ada_2005
- then
- if From_With_Type (T) then
+ if Ada_Version >= Ada_2005 then
+
+ -- Test whether the Available_View of a limited type view
+ -- is tagged, since the limited view may not be marked as
+ -- tagged if the type itself has an untagged incomplete
+ -- type view in its package.
+
+ if From_With_Type (T)
+ and then not Is_Tagged_Type (Available_View (T))
+ then
Error_Msg_N
("prefix of Class attribute must be tagged", N);
Set_Etype (N, Any_Type);
end if;
end Use_Class_Wide_Operations;
- -- Start of processing for Use_One_Type;
+ -- Start of processing for Use_One_Type
begin
-- It is the type determined by the subtype mark (8.4(8)) whose
OSDN Git Service
