* clean.adb ("-eL"): Also set Follow_Links_For_Dirs, to match what is
done in other project-aware tools like gnatmake and gprbuild.
2009-11-30 Jerome Lambourg <lambourg@adacore.com>
* exp_ch3.adb (Make_Predefined_Primitive_Specs): Take care of CIL
ValueTypes.
* exp_ch7.adb (Needs_Finalization): Do not finalize CIL valuetypes.
* sem_util.adb (Is_Value_Type): Protect against invalid calls to Chars
(Is_Delegate): New method used for CIL.
* sem_util.ads (Is_Delegate): New method for CIL handling.
(Is_Value_Type): Improve documentation.
2009-11-30 Ed Schonberg <schonberg@adacore.com>
* errout.adb (Unwind_Internal_Type): Improve error reporting if the
type is an anonymous access to subprogram that is the type of a formal
in a subprogram spec.
2009-11-30 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (Check_Interfaces): In a Stand-Alone Library project, if
attribute Interfaces is not declared, then Library_Interface should
define the interfaces.
2009-11-30 Ed Schonberg <schonberg@adacore.com>
* sem_prag.adb: New semantics for Annotate.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154800
138bc75d-0d04-0410-961f-
82ee72b054a4
+2009-11-30 Emmanuel Briot <briot@adacore.com>
+
+ * clean.adb ("-eL"): Also set Follow_Links_For_Dirs, to match what is
+ done in other project-aware tools like gnatmake and gprbuild.
+
+2009-11-30 Jerome Lambourg <lambourg@adacore.com>
+
+ * exp_ch3.adb (Make_Predefined_Primitive_Specs): Take care of CIL
+ ValueTypes.
+ * exp_ch7.adb (Needs_Finalization): Do not finalize CIL valuetypes.
+ * sem_util.adb (Is_Value_Type): Protect against invalid calls to Chars
+ (Is_Delegate): New method used for CIL.
+ * sem_util.ads (Is_Delegate): New method for CIL handling.
+ (Is_Value_Type): Improve documentation.
+
+2009-11-30 Ed Schonberg <schonberg@adacore.com>
+
+ * errout.adb (Unwind_Internal_Type): Improve error reporting if the
+ type is an anonymous access to subprogram that is the type of a formal
+ in a subprogram spec.
+
+2009-11-30 Vincent Celier <celier@adacore.com>
+
+ * prj-nmsc.adb (Check_Interfaces): In a Stand-Alone Library project, if
+ attribute Interfaces is not declared, then Library_Interface should
+ define the interfaces.
+
+2009-11-30 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_prag.adb: New semantics for Annotate.
+
2009-11-30 Tristan Gingold <gingold@adacore.com>
* gcc-interface/Makefile.in: Do not link with -static-libgcc on Darwin.
when 'e' =>
if Arg = "-eL" then
Follow_Links_For_Files := True;
+ Follow_Links_For_Dirs := True;
else
Bad_Argument;
Buffer_Remove ("type ");
end if;
- Set_Msg_Str ("access to subprogram with profile ");
+ if Is_Itype (Ent) then
+ declare
+ Assoc : constant Node_Id :=
+ Associated_Node_For_Itype (Ent);
+
+ begin
+ if Nkind (Assoc) = N_Procedure_Specification
+ or else Nkind (Assoc) = N_Function_Specification
+ then
+
+ -- Anonymous access to subprogram in a signature
+ -- Indicate the enclosing subprogram.
+
+ Ent :=
+ Defining_Unit_Name
+ (Associated_Node_For_Itype (Ent));
+ Set_Msg_Str
+ ("access to subprogram declared in profile of ");
+
+ else
+ Set_Msg_Str ("access to subprogram with profile ");
+ end if;
+ end;
+ end if;
elsif Ekind (Ent) = E_Function then
Set_Msg_Str ("access to function ");
and then not Is_Limited_Interface (Tag_Typ)
and then Is_Limited_Interface (Etype (Tag_Typ)))
then
- if not Is_Limited_Type (Tag_Typ) then
+ if not Is_Limited_Type (Tag_Typ)
+ and then not Is_Value_Type (Tag_Typ)
+ then
Append_To (Res,
Predef_Deep_Spec (Loc, Tag_Typ, TSS_Deep_Adjust));
end if;
return (Is_Class_Wide_Type (T)
and then not In_Finalization_Root (T)
- and then not Restriction_Active (No_Finalization))
+ and then not Restriction_Active (No_Finalization)
+ and then not Is_Value_Type (Etype (T)))
or else Is_Controlled (T)
or else Has_Some_Controlled_Component (T)
or else (Is_Concurrent_Type (T)
Project.Decl.Attributes,
Data.Tree);
+ Library_Interface : constant Prj.Variable_Value :=
+ Prj.Util.Value_Of
+ (Snames.Name_Library_Interface,
+ Project.Decl.Attributes,
+ Data.Tree);
+
List : String_List_Id;
Element : String_Element;
Name : File_Name_Type;
Project.Interfaces_Defined := True;
- elsif Project.Extends /= No_Project then
- Project.Interfaces_Defined := Project.Extends.Interfaces_Defined;
+ elsif Project.Library and then not Library_Interface.Default then
- if Project.Interfaces_Defined then
- Iter := For_Each_Source (Data.Tree, Project);
+ -- Set In_Interfaces to False for all sources. It will be set to True
+ -- later for the sources in the Library_Interface list.
+
+ Project_2 := Project;
+ while Project_2 /= No_Project loop
+ Iter := For_Each_Source (Data.Tree, Project_2);
loop
Source := Prj.Element (Iter);
exit when Source = No_Source;
-
- if not Source.Declared_In_Interfaces then
- Source.In_Interfaces := False;
- end if;
-
+ Source.In_Interfaces := False;
Next (Iter);
end loop;
- end if;
+
+ Project_2 := Project_2.Extends;
+ end loop;
+
+ List := Library_Interface.Values;
+ while List /= Nil_String loop
+ Element := Data.Tree.String_Elements.Table (List);
+ Get_Name_String (Element.Value);
+ To_Lower (Name_Buffer (1 .. Name_Len));
+ Name := Name_Find;
+
+ Project_2 := Project;
+ Big_Loop_2 :
+ while Project_2 /= No_Project loop
+ Iter := For_Each_Source (Data.Tree, Project_2);
+
+ loop
+ Source := Prj.Element (Iter);
+ exit when Source = No_Source;
+
+ if Source.Unit /= No_Unit_Index and then
+ Source.Unit.Name = Name_Id (Name)
+ then
+ if not Source.Locally_Removed then
+ Source.In_Interfaces := True;
+ Source.Declared_In_Interfaces := True;
+
+ Other := Other_Part (Source);
+
+ if Other /= No_Source then
+ Other.In_Interfaces := True;
+ Other.Declared_In_Interfaces := True;
+ end if;
+
+ if Current_Verbosity = High then
+ Write_Str (" interface: ");
+ Write_Line (Get_Name_String (Source.Path.Name));
+ end if;
+ end if;
+
+ exit Big_Loop_2;
+ end if;
+
+ Next (Iter);
+ end loop;
+
+ Project_2 := Project_2.Extends;
+ end loop Big_Loop_2;
+
+ List := Element.Next;
+ end loop;
+
+ Project.Interfaces_Defined := True;
+
+ elsif Project.Extends /= No_Project and then
+ Project.Extends.Interfaces_Defined
+ then
+ Project.Interfaces_Defined := True;
+
+ Iter := For_Each_Source (Data.Tree, Project);
+ loop
+ Source := Prj.Element (Iter);
+ exit when Source = No_Source;
+
+ if not Source.Declared_In_Interfaces then
+ Source.In_Interfaces := False;
+ end if;
+
+ Next (Iter);
+ end loop;
end if;
end Check_Interfaces;
-- Annotate --
--------------
- -- pragma Annotate (IDENTIFIER {, ARG});
+ -- pragma Annotate (IDENTIFIER, [IDENTIFIER], {, ARG});
-- ARG ::= NAME | EXPRESSION
+ -- The first two arguments are by convention intended to refer
+ -- to an external tool and a tool-specific function. These
+ -- arguments are not analyzed.
when Pragma_Annotate => Annotate : begin
GNAT_Pragma;
Exp : Node_Id;
begin
- Arg := Arg2;
- while Present (Arg) loop
- Exp := Expression (Arg);
- Analyze (Exp);
+ if No (Arg2) then
+ Error_Pragma_Arg
+ ("pragma requires at least two arguments", Arg1);
- if Is_Entity_Name (Exp) then
- null;
+ else
+ Arg := Next (Arg2);
+ while Present (Arg) loop
+ Exp := Expression (Arg);
+ Analyze (Exp);
- elsif Nkind (Exp) = N_String_Literal then
- Resolve (Exp, Standard_String);
+ if Is_Entity_Name (Exp) then
+ null;
- elsif Is_Overloaded (Exp) then
- Error_Pragma_Arg ("ambiguous argument for pragma%", Exp);
+ elsif Nkind (Exp) = N_String_Literal then
+ Resolve (Exp, Standard_String);
- else
- Resolve (Exp);
- end if;
+ elsif Is_Overloaded (Exp) then
+ Error_Pragma_Arg
+ ("ambiguous argument for pragma%", Exp);
- Next (Arg);
- end loop;
+ else
+ Resolve (Exp);
+ end if;
+
+ Next (Arg);
+ end loop;
+ end if;
end;
end Annotate;
function Is_Value_Type (T : Entity_Id) return Boolean is
begin
return VM_Target = CLI_Target
+ and then Nkind (T) in N_Has_Chars
and then Chars (T) /= No_Name
and then Get_Name_String (Chars (T)) = "valuetype";
end Is_Value_Type;
-----------------
+ -- Is_Delegate --
+ -----------------
+
+ function Is_Delegate (T : Entity_Id) return Boolean is
+ Desig_Type : Entity_Id;
+ begin
+ if VM_Target /= CLI_Target then
+ return False;
+ end if;
+
+ -- Access-to-subprograms are delegates in CIL
+ if Ekind (T) = E_Access_Subprogram_Type then
+ return True;
+ end if;
+
+ if Ekind (T) not in Access_Kind then
+ -- a delegate is a managed pointer. If no designated type is defined
+ -- it means that it's not a delegate.
+ return False;
+ end if;
+
+ Desig_Type := Etype (Directly_Designated_Type (T));
+
+ if not Is_Tagged_Type (Desig_Type) then
+ return False;
+ end if;
+
+ -- Test if the type is inherited from [mscorlib]System.Delegate
+ while Etype (Desig_Type) /= Desig_Type loop
+ if Chars (Scope (Desig_Type)) /= No_Name
+ and then Is_Imported (Scope (Desig_Type))
+ and then Get_Name_String (Chars (Scope (Desig_Type))) = "delegate"
+ then
+ return True;
+ end if;
+
+ Desig_Type := Etype (Desig_Type);
+ end loop;
+
+ return False;
+ end Is_Delegate;
+
+ -----------------
-- Is_Variable --
-----------------
function Is_Value_Type (T : Entity_Id) return Boolean;
-- Returns true if type T represents a value type. This is only relevant to
-- CIL, will always return false for other targets.
- -- What is a "value type", since this is not an Ada term, it should be
- -- defined here ???
+ -- A value type is a CIL object that is accessed directly, as opposed to
+ -- the other CIL objects that are accessed through managed pointers.
+
+ function Is_Delegate (T : Entity_Id) return Boolean;
+ -- Returns true if type T represents a delegate. A Delegate is the CIL
+ -- object used to represent access-to-subprogram types.
+ -- This is only relevant to CIL, will always return false for other
+ -- targets.
function Is_Variable (N : Node_Id) return Boolean;
-- Determines if the tree referenced by N represents a variable, i.e.
OSDN Git Service
