+2012-06-12 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch7.adb (Create_Finalizer): Add the
+ exception reraise mechanism at the very end of the finalizer
+ statements. This placement ensures that all objects are finalized,
+ the secondary stack mark released and aborts undeferred before
+ propagating an exception.
+
+2012-06-12 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch10.adb (Remove_Unit_From_Visibility): if the unit is a
+ wrapper package. remove from visibility the original subprogram
+ instance.
+
+2012-06-12 Javier Miranda <miranda@adacore.com>
+
+ * sem_prag.adb (Process_Convention): Generate reference to entity
+ exported to foreign language. Needed for GPS navigation.
+ * xref_lib.adb (Parse_Identifier_Info): Parse exported entities.
+ * lib-xref (Output_References): Output exported entities.
+
+2012-06-12 Pascal Obry <obry@adacore.com>
+
+ * prj-attr.adb: Add install package and corresponding attributes.
+ * snames.ads-tmpl (Name_Active): New constant.
+ (Name_Exec_Subdir): Likewise.
+ (Name_Install): Likewise.
+ (Name_Lib_Subdir): Likewise.
+ (Name_Project_Subdir): Likewise.
+ (Name_Sources_Subdir): Likewise.
+
+2012-06-12 Bob Duff <duff@adacore.com>
+
+ * sem_res.adb (Check_Infinite_Recursion):
+ Suppress spurious warning on recursion after "raise with ...".
+
2012-06-12 Thomas Quinot <quinot@adacore.com>
* sem_prag.adb (Analyze_Pragma, case Unchecked_Union): Do
Append_To (Finalizer_Stmts, Label);
- -- The local exception does not need to be reraised for library-
- -- level finalizers. Generate:
- --
- -- if Raised and then not Abort then
- -- Raise_From_Controlled_Operation (E);
- -- end if;
-
- if not For_Package
- and then Exceptions_OK
- then
- Append_To (Finalizer_Stmts,
- Build_Raise_Statement (Finalizer_Data));
- end if;
-
-- Create the jump block which controls the finalization flow
-- depending on the value of the state counter.
Name => New_Reference_To (RTE (RE_Abort_Undefer), Loc)));
end if;
+ -- The local exception does not need to be reraised for library-level
+ -- finalizers. Note that this action must be carried out after object
+ -- clean up, secondary stack release and abort undeferral. Generate:
+
+ -- if Raised and then not Abort then
+ -- Raise_From_Controlled_Operation (E);
+ -- end if;
+
+ if Has_Ctrl_Objs
+ and then Exceptions_OK
+ and then not For_Package
+ then
+ Append_To (Finalizer_Stmts,
+ Build_Raise_Statement (Finalizer_Data));
+ end if;
+
-- Generate:
-- procedure Fin_Id is
-- Abort : constant Boolean := Triggered_By_Abort;
-- <finalization statements> -- Added if Has_Ctrl_Objs
-- <stack release> -- Added if Mark_Id exists
-- Abort_Undefer; -- Added if abort is allowed
+ -- <exception propagation> -- Added if Has_Ctrl_Objs
-- end Fin_Id;
-- Create the body of the finalizer
(Int (Get_Logical_Line_Number (XE.Key.Loc)));
Write_Info_Char (XE.Key.Typ);
- if Is_Overloadable (XE.Key.Ent)
- and then Is_Imported (XE.Key.Ent)
- and then XE.Key.Typ = 'b'
- then
- Output_Import_Export_Info (XE.Key.Ent);
+ if Is_Overloadable (XE.Key.Ent) then
+ if (Is_Imported (XE.Key.Ent) and then XE.Key.Typ = 'b')
+ or else
+ (Is_Exported (XE.Key.Ent) and then XE.Key.Typ = 'i')
+ then
+ Output_Import_Export_Info (XE.Key.Ent);
+ end if;
end if;
Write_Info_Nat (Int (Get_Column_Number (XE.Key.Loc)));
"SVvcs_log_check#" &
"SVdocumentation_dir#" &
+ -- package Install
+
+ "Pinstall#" &
+ "SVprefix#" &
+ "SVsources_subdir#" &
+ "SVexec_subdir#" &
+ "SVlib_subdir#" &
+ "SVproject_subdir#" &
+ "SVactive#" &
+
-- package Stack
"Pstack#" &
Set_Is_Potentially_Use_Visible (Unit_Name, False);
Set_Is_Immediately_Visible (Unit_Name, False);
+
+ -- If the unit is a wrapper package, the subprogram instance is
+ -- what must be removed from visibility.
+
+ if Is_Wrapper_Package (Unit_Name) then
+ Set_Is_Immediately_Visible (Current_Entity (Unit_Name), False);
+ end if;
end Remove_Unit_From_Visibility;
--------
Comp_Unit := Get_Source_Unit (E);
Set_Convention_From_Pragma (E);
- -- Treat a pragma Import as an implicit body, for GPS use
+ -- Treat a pragma Import as an implicit body, and pragma import
+ -- as implicit reference (for navigation in GPS).
if Prag_Id = Pragma_Import then
Generate_Reference (E, Id, 'b');
+
+ -- For exported entities we restrict the generation of references
+ -- to entities exported to foreign languages since entities
+ -- exported to Ada do not provide further information to GPS and
+ -- add undesired references to the output of the gnatxref tool.
+
+ elsif Prag_Id = Pragma_Export
+ and then Convention (E) /= Convention_Ada
+ then
+ Generate_Reference (E, Id, 'i');
end if;
-- Loop through the homonyms of the pragma argument's entity
Prev (Nod);
end loop;
- -- If no raise statement, give warning
+ -- If no raise statement, give warning. We look at the
+ -- original node, because in the case of "raise ... with
+ -- ...", the node has been transformed into a call.
- exit when Nkind (Nod) /= N_Raise_Statement
+ exit when Nkind (Original_Node (Nod)) /= N_Raise_Statement
and then
(Nkind (Nod) not in N_Raise_xxx_Error
or else Present (Condition (Nod)));
-- The names with the -- GB annotation are only used in gprbuild.
+ Name_Active : constant Name_Id := N + $;
Name_Aggregate : constant Name_Id := N + $;
Name_Archive_Builder : constant Name_Id := N + $;
Name_Archive_Builder_Append_Option : constant Name_Id := N + $;
Name_Excluded_Source_Files : constant Name_Id := N + $;
Name_Excluded_Source_List_File : constant Name_Id := N + $;
Name_Exec_Dir : constant Name_Id := N + $;
+ Name_Exec_Subdir : constant Name_Id := N + $;
Name_Executable : constant Name_Id := N + $;
Name_Executable_Suffix : constant Name_Id := N + $;
Name_Extends : constant Name_Id := N + $;
Name_Include_Path : constant Name_Id := N + $;
Name_Include_Path_File : constant Name_Id := N + $;
Name_Inherit_Source_Path : constant Name_Id := N + $;
+ Name_Install : constant Name_Id := N + $;
Name_Languages : constant Name_Id := N + $;
Name_Language_Kind : constant Name_Id := N + $;
Name_Leading_Library_Options : constant Name_Id := N + $;
Name_Leading_Required_Switches : constant Name_Id := N + $;
Name_Leading_Switches : constant Name_Id := N + $;
+ Name_Lib_Subdir : constant Name_Id := N + $;
Name_Library : constant Name_Id := N + $;
Name_Library_Ali_Dir : constant Name_Id := N + $;
Name_Library_Auto_Init : constant Name_Id := N + $;
Name_Project_Dir : constant Name_Id := N + $;
Name_Project_Files : constant Name_Id := N + $;
Name_Project_Path : constant Name_Id := N + $;
+ Name_Project_Subdir : constant Name_Id := N + $;
Name_Response_File_Format : constant Name_Id := N + $;
Name_Response_File_Switches : constant Name_Id := N + $;
Name_Roots : constant Name_Id := N + $; -- GB
Name_Source_File_Switches : constant Name_Id := N + $;
Name_Source_Files : constant Name_Id := N + $;
Name_Source_List_File : constant Name_Id := N + $;
+ Name_Sources_Subdir : constant Name_Id := N + $;
Name_Spec : constant Name_Id := N + $;
Name_Spec_Suffix : constant Name_Id := N + $;
Name_Specification : constant Name_Id := N + $;
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-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- --
-- Imported entities might special indication as to their external
-- name:
- -- 5U14*Foo2 5>20 6b<c,myfoo2>22
+ -- 5U14*Foo2 5>20 6b<c,myfoo2>22 # Imported entity
+ -- 5U14*Foo2 5>20 6i<c,myfoo2>22 # Exported entity
- if R_Type = 'b'
+ if (R_Type = 'b' or else R_Type = 'i')
and then Ali (Ptr) = '<'
then
while Ptr <= Ali'Last
git://gcc.gnu.org / gcc.git / commitdiff