From: Arnaud Charlet Date: Fri, 1 Aug 2014 14:05:00 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=41d8ee1d52ca454571226a1083fcd66b169c5cda;p=gcc.git [multiple changes] 2014-08-01 Hristian Kirtchev * 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 * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4c906dd6663..9b58a0836a2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2014-08-01 Hristian Kirtchev + + * 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 + + * 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 * sem_ch8.adb: Minor reformatting. diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index 536133f9ff7..f955c2f34d3 100644 --- a/gcc/ada/osint-c.adb +++ b/gcc/ada/osint-c.adb @@ -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 -- ------------------------- diff --git a/gcc/ada/osint-c.ads b/gcc/ada/osint-c.ads index 2faef5ed787..0d6646ed3fa 100644 --- a/gcc/ada/osint-c.ads +++ b/gcc/ada/osint-c.ads @@ -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 diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 2fb1618e6e1..93e25501f77 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -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 -- ------------------------ diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index 0ff67381f71..e281c6a79ad 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -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); diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 8ea87f2699a..3fad849b87a 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -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 -- --------------- diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index d3ded15ee4a..2a24ca29d62 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index a741cfffd4d..f454a1e56e5 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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; - - 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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 33d163b08ed..a711f1b3a3b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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;