From: charlet Date: Fri, 8 Oct 2010 10:45:13 +0000 (+0000) Subject: 2010-10-08 Thomas Quinot X-Git-Tag: upstream/4.9.2~25995 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=316b941e5bf55ade4db5ad4c2f6a6af6a60badef;p=platform%2Fupstream%2Flinaro-gcc.git 2010-10-08 Thomas Quinot * xsnames.adb: Remove obsolete file. * make.adb, sem_ch8.adb, einfo.ads: Minor reformatting. 2010-10-08 Ed Schonberg * exp_aggr.adb: Complete previous change. 2010-10-08 Ed Schonberg * sem_ch6.adb (Check_Return_Subtype): The subtype indication in an extended return must match statically the return subtype of the enclosing function if the type is an elementary type or if it is constrained. 2010-10-08 Vincent Celier * prj-nmsc.adb (Add_Source): Report all duplicate units and source file names. Do not report the same duplicate unit several times. * prj.ads (Source_Data): New Boolean component Duplicate_Unit, defaulted to False, to avoid reporting the same unit as duplicate several times. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165160 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a61e306..b35cf85 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2010-10-08 Thomas Quinot + + * xsnames.adb: Remove obsolete file. + * make.adb, sem_ch8.adb, einfo.ads: Minor reformatting. + +2010-10-08 Ed Schonberg + + * exp_aggr.adb: Complete previous change. + +2010-10-08 Ed Schonberg + + * sem_ch6.adb (Check_Return_Subtype): The subtype indication in an + extended return must match statically the return subtype of the + enclosing function if the type is an elementary type or if it is + constrained. + +2010-10-08 Vincent Celier + + * prj-nmsc.adb (Add_Source): Report all duplicate units and source file + names. Do not report the same duplicate unit several times. + * prj.ads (Source_Data): New Boolean component Duplicate_Unit, + defaulted to False, to avoid reporting the same unit as duplicate + several times. + 2010-10-08 Ed Schonberg * sem_aggr.adb (Resolve_Array_Aggregate): If the expression in an diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 074eefc..5611278 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -6863,7 +6863,7 @@ package Einfo is -- Empty is returned. function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id; - -- Searches the Rep_Item chain for a given entyt E, for a record + -- Searches the Rep_Item chain for a given entity E, for a record -- representation clause, and if found, returns it. Returns Empty -- if no such clause is found. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index ba3d5de..e60f216 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5599,7 +5599,9 @@ package body Exp_Aggr is -- aggregates for C++ imported types must be expanded. if Ada_Version >= Ada_05 and then Is_Inherently_Limited_Type (Typ) then - if Nkind (Parent (N)) /= N_Object_Declaration then + if not Nkind_In (Parent (N), N_Object_Declaration, + N_Component_Association) + then Convert_To_Assignments (N, Typ); elsif Nkind (N) = N_Extension_Aggregate diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index f88de1a..8774ba7 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -1916,8 +1916,7 @@ package body Make is if ALI_Project = No_Project then ALI := No_ALI_Id; - Verbose_Msg - (Lib_File, " wrong object directory"); + Verbose_Msg (Lib_File, " wrong object directory"); return; end if; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 59f10fe..a8af37f 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -705,9 +705,13 @@ package body Prj.Nmsc is -- (for instance because of symbolic links). elsif Source.Path.Name /= Path.Name then - Error_Msg_Name_1 := Unit; - Error_Msg - (Data.Flags, "duplicate unit %%", Location, Project); + if not Source.Duplicate_Unit then + Error_Msg_Name_1 := Unit; + Error_Msg + (Data.Flags, "\duplicate unit %%", Location, Project); + Source.Duplicate_Unit := True; + end if; + Add_Src := False; end if; end if; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 4fc6c93..84c825f 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -765,6 +765,9 @@ package Prj is Naming_Exception : Boolean := False; -- True if the source has an exceptional name + Duplicate_Unit : Boolean := False; + -- True when a duplicate unit has been reported for this source + Next_In_Lang : Source_Id := No_Source; -- Link to another source of the same language in the same project end record; @@ -799,6 +802,7 @@ package Prj is Switches_Path => No_Path, Switches_TS => Empty_Time_Stamp, Naming_Exception => False, + Duplicate_Unit => False, Next_In_Lang => No_Source); package Source_Paths_Htable is new Simple_HTable diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index d1ec09a..e74aaf7 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -620,7 +620,12 @@ package body Sem_Ch6 is Subtype_Ind); end if; - if Is_Constrained (R_Type) then + -- AI05-103 : for elementary types, subtypes must statically + -- match. + + if Is_Constrained (R_Type) + or else Is_Access_Type (R_Type) + then if not Subtypes_Statically_Match (R_Stm_Type, R_Type) then Error_Msg_N ("subtype must statically match function result subtype", diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 1ea8277..2e3b22f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3076,7 +3076,7 @@ package body Sem_Ch8 is -- The replacement of a discriminant by the corresponding discriminal -- is not done for a task discriminant that appears in a default - -- expression of an entry parameter. See Expand_Discriminant in exp_ch2 + -- expression of an entry parameter. See Exp_Ch2.Expand_Discriminant -- for details on their handling. elsif Is_Concurrent_Type (Scope (E)) then diff --git a/gcc/ada/xsnames.adb b/gcc/ada/xsnames.adb deleted file mode 100644 index d43631a..0000000 --- a/gcc/ada/xsnames.adb +++ /dev/null @@ -1,244 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- X S N A M E S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2008, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This utility is used to make a new version of the Snames package when new --- names are added to the spec, the existing versions of snames.ads and --- snames.adb and snames.h are read, and updated to match the set of names in --- snames.ads. The updated versions are written to snames.ns, snames.nb (new --- spec/body), and snames.nh (new header file). - -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; -with Ada.Strings.Maps; use Ada.Strings.Maps; -with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Spitbol; use GNAT.Spitbol; -with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; - -procedure XSnames is - - InB : File_Type; - InS : File_Type; - OutS : File_Type; - OutB : File_Type; - InH : File_Type; - OutH : File_Type; - - A, B : VString := Nul; - Line : VString := Nul; - Name : VString := Nul; - Name1 : VString := Nul; - Oval : VString := Nul; - Restl : VString := Nul; - - Tdigs : constant Pattern := Any (Decimal_Digit_Set) & - Any (Decimal_Digit_Set) & - Any (Decimal_Digit_Set); - - Name_Ref : constant Pattern := Span (' ') * A & Break (' ') * Name - & Span (' ') * B - & ": constant Name_Id := N + " & Tdigs - & ';' & Rest * Restl; - - Get_Name : constant Pattern := "Name_" & Rest * Name1; - Chk_Low : constant Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1); - Findu : constant Pattern := Span ('u') * A; - - Val : Natural; - - Xlate_U_Und : constant Character_Mapping := To_Mapping ("u", "_"); - - M : Match_Result; - - type Header_Symbol is (None, Attr, Conv, Prag); - -- A symbol in the header file - - procedure Output_Header_Line (S : Header_Symbol); - -- Output header line - - Header_Attr : aliased String := "Attr"; - Header_Conv : aliased String := "Convention"; - Header_Prag : aliased String := "Pragma"; - -- Prefixes used in the header file - - type String_Ptr is access all String; - Header_Prefix : constant array (Header_Symbol) of String_Ptr := - (null, - Header_Attr'Access, - Header_Conv'Access, - Header_Prag'Access); - - -- Patterns used in the spec file - - Get_Attr : constant Pattern := Span (' ') & "Attribute_" - & Break (",)") * Name1; - Get_Conv : constant Pattern := Span (' ') & "Convention_" - & Break (",)") * Name1; - Get_Prag : constant Pattern := Span (' ') & "Pragma_" - & Break (",)") * Name1; - - type Header_Symbol_Counter is array (Header_Symbol) of Natural; - Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0); - - Header_Current_Symbol : Header_Symbol := None; - Header_Pending_Line : VString := Nul; - - ------------------------ - -- Output_Header_Line -- - ------------------------ - - procedure Output_Header_Line (S : Header_Symbol) is - begin - -- Skip all the #define for S-prefixed symbols in the header. - -- Of course we are making implicit assumptions: - -- (1) No newline between symbols with the same prefix. - -- (2) Prefix order is the same as in snames.ads. - - if Header_Current_Symbol /= S then - declare - Pat : constant String := "#define " & Header_Prefix (S).all; - In_Pat : Boolean := False; - - begin - if Header_Current_Symbol /= None then - Put_Line (OutH, Header_Pending_Line); - end if; - - loop - Line := Get_Line (InH); - - if Match (Line, Pat) then - In_Pat := True; - elsif In_Pat then - Header_Pending_Line := Line; - exit; - else - Put_Line (OutH, Line); - end if; - end loop; - - Header_Current_Symbol := S; - end; - end if; - - -- Now output the line - - Put_Line (OutH, "#define " & Header_Prefix (S).all - & "_" & Name1 & (30 - Length (Name1)) * ' ' - & Header_Counter (S)); - Header_Counter (S) := Header_Counter (S) + 1; - end Output_Header_Line; - --- Start of processing for XSnames - -begin - Open (InB, In_File, "snames.adb"); - Open (InS, In_File, "snames.ads"); - Open (InH, In_File, "snames.h"); - - Create (OutS, Out_File, "snames.ns"); - Create (OutB, Out_File, "snames.nb"); - Create (OutH, Out_File, "snames.nh"); - - Anchored_Mode := True; - Val := 0; - - loop - Line := Get_Line (InB); - exit when Match (Line, " Preset_Names"); - Put_Line (OutB, Line); - end loop; - - Put_Line (OutB, Line); - - LoopN : while not End_Of_File (InS) loop - Line := Get_Line (InS); - - if not Match (Line, Name_Ref) then - Put_Line (OutS, Line); - - if Match (Line, Get_Attr) then - Output_Header_Line (Attr); - elsif Match (Line, Get_Conv) then - Output_Header_Line (Conv); - elsif Match (Line, Get_Prag) then - Output_Header_Line (Prag); - end if; - else - Oval := Lpad (V (Val), 3, '0'); - - if Match (Name, "Last_") then - Oval := Lpad (V (Val - 1), 3, '0'); - end if; - - Put_Line - (OutS, A & Name & B & ": constant Name_Id := N + " - & Oval & ';' & Restl); - - if Match (Name, Get_Name) then - Name := Name1; - Val := Val + 1; - - if Match (Name, Findu, M) then - Replace (M, Translate (A, Xlate_U_Und)); - Translate (Name, Lower_Case_Map); - - elsif not Match (Name, "Op_", "") then - Translate (Name, Lower_Case_Map); - - else - Name := 'O' & Translate (Name, Lower_Case_Map); - end if; - - if Name = "error" then - Name := V (""); - end if; - - if not Match (Name, Chk_Low) then - Put_Line (OutB, " """ & Name & "#"" &"); - end if; - end if; - end if; - end loop LoopN; - - loop - Line := Get_Line (InB); - exit when Match (Line, " ""#"";"); - end loop; - - Put_Line (OutB, Line); - - while not End_Of_File (InB) loop - Line := Get_Line (InB); - Put_Line (OutB, Line); - end loop; - - Put_Line (OutH, Header_Pending_Line); - while not End_Of_File (InH) loop - Line := Get_Line (InH); - Put_Line (OutH, Line); - end loop; -end XSnames;