OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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.

From-SVN: r213470
This commit is contained in:
Arnaud Charlet 2014-08-01 16:05:00 +02:00
parent 2feb1f84d7
commit 41d8ee1d52
9 changed files with 174 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
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.

10
gcc/ada/osint-c.adb
View File

@ -197,6 +197,16 @@ package body Osint.C is
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 --
-------------------------

8
gcc/ada/osint-c.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -127,6 +127,12 @@ package Osint.C is
-- 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

17
gcc/ada/osint.adb
View File

@ -722,6 +722,23 @@ package body Osint is
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 --
------------------------

9
gcc/ada/osint.ads
View File

@ -725,6 +725,15 @@ private
-- 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);

27
gcc/ada/s-os_lib.adb
View File

@ -2257,6 +2257,33 @@ package body System.OS_Lib is
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 --
---------------

20
gcc/ada/s-os_lib.ads
View File

@ -208,14 +208,22 @@ package System.OS_Lib is
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;
@ -642,6 +650,10 @@ package System.OS_Lib is
(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;

107
gcc/ada/sem_ch13.adb
View File

@ -1859,67 +1859,92 @@ package body Sem_Ch13 is
-- 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;
Extern_Arg := Empty;
Link_Arg := Empty;
Prag_Nam := Chars (Id);
A := First (L);
while Present (A) loop
A_Name := Chars (Identifier (A));
Asp := First (L);
while Present (Asp) loop
Asp_Nam := Chars (Identifier (Asp));
if Nam_In (A_Name, Name_Import, Name_Export) then
if Found then
Error_Msg_N ("conflicting", A);
-- 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;
elsif A_Name = Name_Link_Name then
L_Assoc :=
Make_Pragma_Argument_Association (Loc,
Chars => A_Name,
Expression => Relocate_Node (Expression (A)));
-- Aspect External_Name adds an extra argument to the
-- generated pragma.
elsif A_Name = Name_External_Name then
E_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)));
-- 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 => 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

3
gcc/ada/sem_prag.adb
View File

@ -25104,6 +25104,9 @@ package body Sem_Prag is
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;