+2009-04-15 Robert Dewar <dewar@adacore.com>
+
+ * rtsfind.adb: Minor reformatting.
+
+2009-04-15 Emmanuel Briot <briot@adacore.com>
+
+ * prj-part.adb, prj-tree.adb, prj-tree.ads (Restore_And_Free): renames
+ Restore, and free the saved context.
+
+2009-04-15 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_ch3.adb (Analyze_Private_Extension_Declaration): Move error check
+ for illegal private extension from a synchronized interface parent in
+ front of check for illegal limited extension so that limited extension
+ from a synchronized interface will be rejected.
+ (Check_Ifaces): Check that a private extension that has a synchronized
+ interface as a progenitor must be explicitly declared synchronized.
+ Also check that a record extension cannot derive from a synchronized
+ interface.
+
2009-04-15 Pascal Obry <obry@adacore.com>
* adaint.h (__gnat_unlink): Add spec.
-- And restore the comment state that was saved
- Tree.Restore (Project_Comment_State);
+ Tree.Restore_And_Free (Project_Comment_State);
end Parse_Single_Project;
-----------------------
Comments.Set_Last (0);
end Reset_State;
- -------------
- -- Restore --
- -------------
+ ----------------------
+ -- Restore_And_Free --
+ ----------------------
+
+ procedure Restore_And_Free (S : in out Comment_State) is
+ procedure Unchecked_Free is new
+ Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr);
- procedure Restore (S : Comment_State) is
begin
End_Of_Line_Node := S.End_Of_Line_Node;
Previous_Line_Node := S.Previous_Line_Node;
Comments.Increment_Last;
Comments.Table (Comments.Last) := S.Comments (J);
end loop;
- end Restore;
+
+ Unchecked_Free (S.Comments);
+ end Restore_And_Free;
----------
-- Save --
-- Save in variable S the comment state. Called before scanning a new
-- project file.
- procedure Restore (S : Comment_State);
+ procedure Restore_And_Free (S : in out Comment_State);
-- Restore the comment state to a previously saved value. Called after
- -- scanning a project file.
+ -- scanning a project file. Frees the memory occupied by S
procedure Reset_State;
-- Set the comment state to its initial value. Called before scanning a
procedure Maybe_Add_With (E : RE_Id; U : in out RT_Unit_Table_Record) is
Is_Main : constant Boolean :=
- In_Extended_Main_Code_Unit (Cunit_Entity (Current_Sem_Unit));
+ In_Extended_Main_Code_Unit (Cunit_Entity (Current_Sem_Unit));
begin
-- We do not need to generate a with_clause for a call issued from
-- Here if we've decided to add the with_clause
declare
- Lib_Unit : constant Node_Id := Unit (Cunit (U.Unum));
- Withn : constant Node_Id :=
- Make_With_Clause (Standard_Location,
- Name =>
- Make_Unit_Name
- (E, Defining_Unit_Name (Specification (Lib_Unit))));
+ LibUnit : constant Node_Id := Unit (Cunit (U.Unum));
+ Withn : constant Node_Id :=
+ Make_With_Clause (Standard_Location,
+ Name =>
+ Make_Unit_Name
+ (E, Defining_Unit_Name (Specification (LibUnit))));
begin
- Set_Library_Unit (Withn, Cunit (U.Unum));
- Set_Corresponding_Spec (Withn, U.Entity);
- Set_First_Name (Withn, True);
- Set_Implicit_With (Withn, True);
+ Set_Library_Unit (Withn, Cunit (U.Unum));
+ Set_Corresponding_Spec (Withn, U.Entity);
+ Set_First_Name (Withn, True);
+ Set_Implicit_With (Withn, True);
Mark_Rewrite_Insertion (Withn);
Append (Withn, Context_Items (Cunit (Current_Sem_Unit)));
end if;
end if;
+ -- A consequence of 3.9.4 (6/2) and 7.3 (7.2/2) is that a private
+ -- extension with a synchronized parent must be explicitly declared
+ -- synchronized, because the full view will be a synchronized type.
+ -- This must be checked before the check for limited types below,
+ -- to ensure that types declared limited are not allowed extend
+ -- synchronized interfaces.
+
+ elsif Is_Interface (Parent_Type)
+ and then Is_Synchronized_Interface (Parent_Type)
+ and then not Synchronized_Present (N)
+ then
+ Error_Msg_NE
+ ("private extension of& must be explicitly synchronized",
+ N, Parent_Type);
+
elsif Limited_Present (N) then
Set_Is_Limited_Record (T);
Error_Msg_NE ("parent type& of limited extension must be limited",
N, Parent_Type);
end if;
-
- -- A consequence of 3.9.4 (6/2) and 7.3 (2.2/2) is that a private
- -- extension with a synchronized parent must be explicitly declared
- -- synchronized, because the full view will be a synchronized type.
-
- elsif Is_Interface (Parent_Type)
- and then Is_Synchronized_Interface (Parent_Type)
- and then not Synchronized_Present (N)
- then
- Error_Msg_NE
- ("private extension of& must be explicitly synchronized",
- N, Parent_Type);
end if;
end Analyze_Private_Extension_Declaration;
Is_Protected := True;
end if;
+ if Is_Synchronized_Interface (Iface_Id) then
+
+ -- A consequence of 3.9.4 (6/2) and 7.3 (7.2/2) is that a private
+ -- extension derived from a synchronized interface must explicitly
+ -- be declared synchronized, because the full view will be a
+ -- synchronized type.
+
+ if Nkind (N) = N_Private_Extension_Declaration then
+ if not Synchronized_Present (N) then
+ Error_Msg_NE
+ ("private extension of& must be explicitly synchronized",
+ N, Iface_Id);
+ end if;
+
+ -- However, by 3.9.4(16/2), a full type that is a record extension
+ -- is never allowed to derive from a synchronized interface (note
+ -- that interfaces must be excluded from this check, because those
+ -- are represented by derived type definitions in some cases).
+
+ elsif Nkind (Type_Definition (N)) = N_Derived_Type_Definition
+ and then not Interface_Present (Type_Definition (N))
+ then
+ Error_Msg_N ("record extension cannot derive from synchronized"
+ & " interface", Error_Node);
+ end if;
+ end if;
+
-- Check that the characteristics of the progenitor are compatible
-- with the explicit qualifier in the declaration.
-- The check only applies to qualifiers that come from source.
projects / platform / upstream / gcc.git / commitdiff