+2011-12-12 Robert Dewar <dewar@adacore.com>
+
+ * exp_atag.adb, exp_atag.ads, exp_util.adb, exp_attr.adb,
+ sem_ch13.adb: Minor reformatting.
+
+2011-12-12 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_ch7.adb (Uninstall_Declarations): Don't
+ apply check for incomplete types used as a result type for an
+ access-to-function type when compiling for Ada 2012 or later.
+ * sem_ch6.adb (Analyze_Subprogram_Declaration):
+ Specialize error message for interface subprograms that are
+ not declared abstract nor null (functions can't be declared as
+ null). Also, remove "(Ada 2005)" from message.
+
2011-12-12 Robert Dewar <dewar@adacore.com>
* sem_prag.adb (GNAT_Pragma): Check comes from source.
begin
return
Make_Selected_Component (Loc,
- Prefix =>
- Build_TSD (Loc,
- Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
+ Prefix =>
+ Build_TSD (Loc, Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
Selector_Name =>
- New_Reference_To
- (RTE_Record_Component (RE_Alignment), Loc));
+ New_Reference_To (RTE_Record_Component (RE_Alignment), Loc));
end Build_Get_Alignment;
------------------------------------------
(Loc : Source_Ptr;
Tag_Node : Node_Id) return Node_Id;
-- Build code that retrieves the alignment of the tagged type.
- --
-- Generates: TSD (Tag).Alignment
procedure Build_Get_Predefined_Prim_Op_Address
-- operation _Alignment applied to X.
elsif Is_Class_Wide_Type (Ptyp) then
-
New_Node :=
Build_Get_Alignment (Loc,
Make_Attribute_Reference (Loc,
- Prefix => Pref,
+ Prefix => Pref,
Attribute_Name => Name_Tag));
- if Typ /= Standard_Integer then
-
- -- The context is a specific integer type with which the
- -- original attribute was compatible. The function has a
- -- specific type as well, so to preserve the compatibility
- -- we must convert explicitly.
+ -- Case where the context is a specific integer type with which
+ -- the original attribute was compatible. The function has a
+ -- specific type as well, so to preserve the compatibility we
+ -- must convert explicitly.
+ if Typ /= Standard_Integer then
New_Node := Convert_To (Typ, New_Node);
end if;
Append_To (Actuals, New_Reference_To (Addr_Id, Loc));
Append_To (Actuals, New_Reference_To (Size_Id, Loc));
- if Is_Allocate
- or else not Is_Class_Wide_Type (Desig_Typ)
- then
+ if Is_Allocate or else not Is_Class_Wide_Type (Desig_Typ) then
Append_To (Actuals, New_Reference_To (Alig_Id, Loc));
-- For deallocation of class wide types we obtain the value of
Append_To (Actuals,
Unchecked_Convert_To (RTE (RE_Storage_Offset),
Make_Attribute_Reference (Loc,
- Prefix =>
+ Prefix =>
Make_Explicit_Dereference (Loc, Relocate_Node (Expr)),
Attribute_Name => Name_Alignment)));
end if;
else
Append_To (Actuals, New_Reference_To (Standard_True, Loc));
end if;
+
else
Append_To (Actuals, New_Reference_To (Standard_False, Loc));
end if;
-- P : Root_Storage_Pool
Make_Parameter_Specification (Loc,
- Defining_Identifier =>
- Make_Temporary (Loc, 'P'),
+ Defining_Identifier => Make_Temporary (Loc, 'P'),
Parameter_Type =>
New_Reference_To (RTE (RE_Root_Storage_Pool), Loc)),
Make_Parameter_Specification (Loc,
Defining_Identifier => Addr_Id,
- Out_Present => Is_Allocate,
- Parameter_Type =>
+ Out_Present => Is_Allocate,
+ Parameter_Type =>
New_Reference_To (RTE (RE_Address), Loc)),
-- S : Storage_Count
Make_Parameter_Specification (Loc,
Defining_Identifier => Size_Id,
- Parameter_Type =>
+ Parameter_Type =>
New_Reference_To (RTE (RE_Storage_Count), Loc)),
-- L : Storage_Count
Make_Parameter_Specification (Loc,
Defining_Identifier => Alig_Id,
- Parameter_Type =>
+ Parameter_Type =>
New_Reference_To (RTE (RE_Storage_Count), Loc)))),
Declarations => No_List,
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Reference_To (Proc_To_Call, Loc),
+ Name => New_Reference_To (Proc_To_Call, Loc),
Parameter_Associations => Actuals)))));
-- The newly generated Allocate / Deallocate becomes the default
when Attribute_Alignment => Alignment : declare
Align : constant Uint := Get_Alignment_Value (Expr);
Max_Align : constant Uint := UI_From_Int (Maximum_Alignment);
+
begin
FOnly := True;
elsif Align /= No_Uint then
Set_Has_Alignment_Clause (U_Ent);
- if Is_Tagged_Type (U_Ent)
- and then Align > Max_Align
- then
+ if Is_Tagged_Type (U_Ent) and then Align > Max_Align then
Error_Msg_N
("?alignment for & set to Maximum_Aligment", Nam);
Set_Alignment (U_Ent, Max_Align);
and then Null_Present (Specification (N)))
then
Error_Msg_Name_1 := Chars (Defining_Entity (N));
- Error_Msg_N
- ("(Ada 2005) interface subprogram % must be abstract or null",
- N);
+
+ -- Specialize error message based on procedures vs. functions,
+ -- since functions can't be null subprograms.
+
+ if Ekind (Designator) = E_Procedure then
+ Error_Msg_N
+ ("interface procedure % must be abstract or null", N);
+ else
+ Error_Msg_N ("interface function % must be abstract", N);
+ end if;
end if;
end;
end if;
("type& must be completed in the private part",
Parent (Subp), Id);
- -- The return type of an access_to_function cannot be a
- -- Taft-amendment type.
+ -- The result type of an access-to-function type cannot be a
+ -- Taft-amendment type, unless the version is Ada 2012 or
+ -- later (see AI05-151).
- elsif Ekind (Subp) = E_Subprogram_Type then
+ elsif Ada_Version < Ada_2012
+ and then Ekind (Subp) = E_Subprogram_Type
+ then
if Etype (Subp) = Id
or else
(Is_Class_Wide_Type (Etype (Subp))
projects / thirdparty / gcc.git / commitdiff
