+2014-08-01 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch13.adb (Analyze_Aspect_Specifications): Code
+ reformatting. Store the generated pragma Import in the related
+ subprogram as routine Wrap_Imported_Subprogram will need it later.
+ * sem_prag.adb (Is_Unconstrained_Or_Tagged_Item): An item of
+ a private type with discriminants is considered to fall in the
+ category of unconstrained or tagged items.
+
+2014-08-01 Arnaud charlet <charlet@adacore.com>
+
+ * s-os_lib.adb (Open_Append): New functions to open a file for
+ appending. This binds to the already existing (but not used)
+ __gnat_open_append.
+ * osint.ads, osint.adb (Open_File_To_Append_And_Check): New procedure
+ to open a file for appending.
+ * osint-c.ads, osint-c.adb (Open_Output_Library_Info): New procedure
+ to open the ALI file for appending.
+
2014-08-01 Robert Dewar <dewar@adacore.com>
* sem_ch8.adb: Minor reformatting.
Create_File_And_Check (Output_FD, Text);
end Create_Output_Library_Info;
+ ------------------------------
+ -- Open_Output_Library_Info --
+ ------------------------------
+
+ procedure Open_Output_Library_Info is
+ begin
+ Set_Library_Info_Name;
+ Open_File_To_Append_And_Check (Output_FD, Text);
+ end Open_Output_Library_Info;
+
-------------------------
-- Create_Repinfo_File --
-------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2014, 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- --
-- is currently being compiled (i.e. the file which was most recently
-- returned by Next_Main_Source).
+ procedure Open_Output_Library_Info;
+ -- Opens the output library information file for the source file which
+ -- is currently being compiled (i.e. the file which was most recently
+ -- returned by Next_Main_Source) for appending. This is used to append
+ -- the globals computed in flow analysis in gnatprove mode.
+
procedure Write_Library_Info (Info : String);
-- Writes the contents of the referenced string to the library information
-- file for the main source file currently being compiled (i.e. the file
end if;
end Create_File_And_Check;
+ -----------------------------------
+ -- Open_File_To_Append_And_Check --
+ -----------------------------------
+
+ procedure Open_File_To_Append_And_Check
+ (Fdesc : out File_Descriptor;
+ Fmode : Mode)
+ is
+ begin
+ Output_File_Name := Name_Enter;
+ Fdesc := Open_Append (Name_Buffer'Address, Fmode);
+
+ if Fdesc = Invalid_FD then
+ Fail ("Cannot create: " & Name_Buffer (1 .. Name_Len));
+ end if;
+ end Open_File_To_Append_And_Check;
+
------------------------
-- Current_File_Index --
------------------------
-- parameter is set to either Text or Binary (for details see description
-- of System.OS_Lib.Create_File).
+ procedure Open_File_To_Append_And_Check
+ (Fdesc : out File_Descriptor;
+ Fmode : Mode);
+ -- Opens the file whose name (NUL terminated) is in Name_Buffer (with the
+ -- length in Name_Len), and place the resulting descriptor in Fdesc. Issue
+ -- message and exit with fatal error if file cannot be opened. The Fmode
+ -- parameter is set to either Text or Binary (for details see description
+ -- of System.OS_Lib.Open_Append).
+
type Program_Type is (Compiler, Binder, Make, Gnatls, Unspecified);
-- Program currently running
procedure Set_Program (P : Program_Type);
return "";
end Normalize_Pathname;
+ -----------------
+ -- Open_Append --
+ -----------------
+
+ function Open_Append
+ (Name : C_File_Name;
+ Fmode : Mode) return File_Descriptor
+ is
+ function C_Open_Append
+ (Name : C_File_Name;
+ Fmode : Mode) return File_Descriptor;
+ pragma Import (C, C_Open_Append, "__gnat_open_append");
+ begin
+ return C_Open_Append (Name, Fmode);
+ end Open_Append;
+
+ function Open_Append
+ (Name : String;
+ Fmode : Mode) return File_Descriptor
+ is
+ C_Name : String (1 .. Name'Length + 1);
+ begin
+ C_Name (1 .. Name'Length) := Name;
+ C_Name (C_Name'Last) := ASCII.NUL;
+ return Open_Append (C_Name (C_Name'First)'Address, Fmode);
+ end Open_Append;
+
---------------
-- Open_Read --
---------------
function Open_Read
(Name : String;
Fmode : Mode) return File_Descriptor;
- -- Open file Name for reading, returning file descriptor File descriptor
- -- returned is Invalid_FD if file cannot be opened.
+ -- Open file Name for reading, returning its file descriptor. File
+ -- descriptor returned is Invalid_FD if the file cannot be opened.
function Open_Read_Write
(Name : String;
Fmode : Mode) return File_Descriptor;
- -- Open file Name for both reading and writing, returning file descriptor.
- -- File descriptor returned is Invalid_FD if file cannot be opened.
+ -- Open file Name for both reading and writing, returning its file
+ -- descriptor. File descriptor returned is Invalid_FD if the file
+ -- cannot be opened.
+
+ function Open_Append
+ (Name : String;
+ Fmode : Mode) return File_Descriptor;
+ -- Opens file Name for appending, returning its file descriptor. File
+ -- descriptor returned is Invalid_FD if the file cannot be successfully
+ -- opened.
function Create_File
(Name : String;
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
+ function Open_Append
+ (Name : C_File_Name;
+ Fmode : Mode) return File_Descriptor;
+
function Create_File
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
-- pragma is one of Convention/Import/Export.
declare
- P_Name : Name_Id;
- A_Name : Name_Id;
- A : Node_Id;
- Arg_List : List_Id;
- Found : Boolean;
- L_Assoc : Node_Id;
- E_Assoc : Node_Id;
+ Args : constant List_Id := New_List (
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr)),
+ Make_Pragma_Argument_Association (Sloc (Ent),
+ Expression => Ent));
+
+ Imp_Exp_Seen : Boolean := False;
+ -- Flag set when aspect Import or Export has been seen
+
+ Imp_Seen : Boolean := False;
+ -- Flag set when aspect Import has been seen
+
+ Asp : Node_Id;
+ Asp_Nam : Name_Id;
+ Extern_Arg : Node_Id;
+ Link_Arg : Node_Id;
+ Prag_Nam : Name_Id;
begin
- P_Name := Chars (Id);
- Found := False;
- Arg_List := New_List;
- L_Assoc := Empty;
- E_Assoc := Empty;
-
- A := First (L);
- while Present (A) loop
- A_Name := Chars (Identifier (A));
-
- if Nam_In (A_Name, Name_Import, Name_Export) then
- if Found then
- Error_Msg_N ("conflicting", A);
+ Extern_Arg := Empty;
+ Link_Arg := Empty;
+ Prag_Nam := Chars (Id);
+
+ Asp := First (L);
+ while Present (Asp) loop
+ Asp_Nam := Chars (Identifier (Asp));
+
+ -- Aspects Import and Export take precedence over
+ -- aspect Convention. As a result the generated pragma
+ -- must carry the proper interfacing aspect's name.
+
+ if Nam_In (Asp_Nam, Name_Import, Name_Export) then
+ if Imp_Exp_Seen then
+ Error_Msg_N ("conflicting", Asp);
else
- Found := True;
+ Imp_Exp_Seen := True;
+
+ if Asp_Nam = Name_Import then
+ Imp_Seen := True;
+ end if;
end if;
- P_Name := A_Name;
+ Prag_Nam := Asp_Nam;
+
+ -- Aspect External_Name adds an extra argument to the
+ -- generated pragma.
- elsif A_Name = Name_Link_Name then
- L_Assoc :=
+ elsif Asp_Nam = Name_External_Name then
+ Extern_Arg :=
Make_Pragma_Argument_Association (Loc,
- Chars => A_Name,
- Expression => Relocate_Node (Expression (A)));
+ Chars => Asp_Nam,
+ Expression => Relocate_Node (Expression (Asp)));
- elsif A_Name = Name_External_Name then
- E_Assoc :=
+ -- Aspect Link_Name adds an extra argument to the
+ -- generated pragma.
+
+ elsif Asp_Nam = Name_Link_Name then
+ Link_Arg :=
Make_Pragma_Argument_Association (Loc,
- Chars => A_Name,
- Expression => Relocate_Node (Expression (A)));
+ Chars => Asp_Nam,
+ Expression => Relocate_Node (Expression (Asp)));
end if;
- Next (A);
+ Next (Asp);
end loop;
- Arg_List := New_List (
- Make_Pragma_Argument_Association (Sloc (Expr),
- Expression => Relocate_Node (Expr)),
- Make_Pragma_Argument_Association (Sloc (Ent),
- Expression => Ent));
+ -- Assemble the full argument list
- if Present (L_Assoc) then
- Append_To (Arg_List, L_Assoc);
+ if Present (Link_Arg) then
+ Append_To (Args, Link_Arg);
end if;
- if Present (E_Assoc) then
- Append_To (Arg_List, E_Assoc);
+ if Present (Extern_Arg) then
+ Append_To (Args, Extern_Arg);
end if;
Make_Aitem_Pragma
- (Pragma_Argument_Associations => Arg_List,
- Pragma_Name => P_Name);
+ (Pragma_Argument_Associations => Args,
+ Pragma_Name => Prag_Nam);
+
+ -- Store the generated pragma Import in the related
+ -- subprogram.
+
+ if Imp_Seen and then Is_Subprogram (E) then
+ Set_Import_Pragma (E, Aitem);
+ end if;
end;
-- CPU, Interrupt_Priority, Priority
return Has_Unconstrained_Component (Typ);
end if;
+ elsif Is_Private_Type (Typ) and then Has_Discriminants (Typ) then
+ return True;
+
else
return False;
end if;
projects / gcc.git / commitdiff