diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 21 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/exp_dist.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/prj-dect.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/prj-err.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/prj-err.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/prj-strt.ads | 58 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 11 | ||||
| -rw-r--r-- | gcc/ada/symbols-processing-vms-ia64.adb | 12 |
10 files changed, 118 insertions, 68 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ac910fd..520a806 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2009-07-13 Robert Dewar <dewar@adacore.com> + + * prj.ads, prj-dect.adb, prj-err.ads, prj-err.adb, prj-nmsc.adb, + prj-strt.ads: Minor reformatting + +2009-07-13 Thomas Quinot <quinot@adacore.com> + + * exp_dist.adb (Build_From_Any_Call): For the case of a generic type, + set the type of the From_Any call to the base type. + +2009-07-13 Doug Rupp <rupp@adacore.com> + + * symbols-processing-vms-ia64.adb (Process): Add variables and + constants to retrieve and check for symbol visibility. + +2009-07-13 Javier Miranda <miranda@adacore.com> + + * exp_ch4.adb (Expand_N_Unchecked_Type_Conversion): If conversion is to + the identical type we remove the conversion completely because + it is useless. + 2009-07-13 Emmanuel Briot <briot@adacore.com> * prj-err.adb (Error_Msg): One more case where a message should be diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index e6e539e..624c878 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7919,6 +7919,13 @@ package body Exp_Ch4 is -- the conversion completely, it is useless. if Operand_Type = Target_Type then + + -- Propagate Assignment_OK attribute to the operand + + if Assignment_OK (N) then + Set_Assignment_OK (Operand); + end if; + Rewrite (N, Relocate_Node (Operand)); return; end if; @@ -8506,6 +8513,21 @@ package body Exp_Ch4 is Operand_Type : constant Entity_Id := Etype (Operand); begin + -- Nothing at all to do if conversion is to the identical type so remove + -- the conversion completely, it is useless. + + if Operand_Type = Target_Type then + + -- Propagate Assignment_OK attribute to the operand + + if Assignment_OK (N) then + Set_Assignment_OK (Operand); + end if; + + Rewrite (N, Relocate_Node (Operand)); + return; + end if; + -- If we have a conversion of a compile time known value to a target -- type and the value is in range of the target type, then we can simply -- replace the construct by an integer literal of the correct type. We diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index d975657..b1e77663 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -8617,17 +8617,16 @@ package body Exp_Dist is else declare Decl : Entity_Id; - Typ : Entity_Id := U_Type; begin -- For the subtype representing a generic actual type, go -- to the base type. - if Is_Generic_Actual_Type (Typ) then - Typ := Base_Type (Typ); + if Is_Generic_Actual_Type (U_Type) then + U_Type := Base_Type (U_Type); end if; - Build_From_Any_Function (Loc, Typ, Decl, Fnam); + Build_From_Any_Function (Loc, U_Type, Decl, Fnam); Append_To (Decls, Decl); end; end if; diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index 9b8baf3..b55a7ed 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -79,10 +79,9 @@ package body Prj.Dect is Packages_To_Check : String_List_Access; Is_Config_File : Boolean; Flags : Processing_Flags); - -- Parse declarative items. Depending on In_Zone, some declarative - -- items may be forbidden. - -- Is_Config_File should be set to True if the project represents a config - -- file (.cgpr) since some specific checks apply. + -- Parse declarative items. Depending on In_Zone, some declarative items + -- may be forbidden. Is_Config_File should be set to True if the project + -- represents a config file (.cgpr) since some specific checks apply. procedure Parse_Package_Declaration (In_Tree : Project_Node_Tree_Ref; diff --git a/gcc/ada/prj-err.adb b/gcc/ada/prj-err.adb index c0fa09b..8e0d562 100644 --- a/gcc/ada/prj-err.adb +++ b/gcc/ada/prj-err.adb @@ -99,9 +99,11 @@ package body Prj.Err is end if; if Real_Location = No_Location then + -- If still null, we are parsing a project that was created in-memory -- so we shouldn't report errors for projects that the user has no -- access to in any case. + return; end if; @@ -115,7 +117,7 @@ package body Prj.Err is if Flags.Report_Error /= null then Flags.Report_Error (Project, - Is_Warning => Msg (Msg'First) = '?' or Msg (Msg'First) = '<'); + Is_Warning => Msg (Msg'First) = '?' or else Msg (Msg'First) = '<'); end if; end Error_Msg; diff --git a/gcc/ada/prj-err.ads b/gcc/ada/prj-err.ads index e697e19..d07285e 100644 --- a/gcc/ada/prj-err.ads +++ b/gcc/ada/prj-err.ads @@ -73,11 +73,10 @@ package Prj.Err is Location : Source_Ptr := No_Location; Project : Project_Id := null); -- Output an error message, either through Flags.Error_Report or through - -- Errutil. The location defaults to the project's location ("project" in - -- the source code). - -- If Msg starts with "?", this is a warning, and Warning: is added at the - -- beginning. If Msg starts with "<", see comment for - -- Err_Vars.Error_Msg_Warn + -- Errutil. The location defaults to the project's location ("project" + -- in the source code). If Msg starts with "?", this is a warning, and + -- Warning: is added at the beginning. If Msg starts with "<", see comment + -- for Err_Vars.Error_Msg_Warn. ------------- -- Scanner -- diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 3ad892a..7b04af7 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -196,13 +196,13 @@ package body Prj.Nmsc is Kind : Source_Kind; File_Name : File_Name_Type; Display_File : File_Name_Type; - Naming_Exception : Boolean := False; + Naming_Exception : Boolean := False; Path : Path_Information := No_Path_Information; - Alternate_Languages : Language_List := null; - Unit : Name_Id := No_Name; - Index : Int := 0; - Locally_Removed : Boolean := False; - Location : Source_Ptr := No_Location); + Alternate_Languages : Language_List := null; + Unit : Name_Id := No_Name; + Index : Int := 0; + Locally_Removed : Boolean := False; + Location : Source_Ptr := No_Location); -- Add a new source to the different lists: list of all sources in the -- project tree, list of source of a project and list of sources of a -- language. @@ -539,19 +539,20 @@ package body Prj.Nmsc is Kind : Source_Kind; File_Name : File_Name_Type; Display_File : File_Name_Type; - Naming_Exception : Boolean := False; + Naming_Exception : Boolean := False; Path : Path_Information := No_Path_Information; - Alternate_Languages : Language_List := null; - Unit : Name_Id := No_Name; - Index : Int := 0; - Locally_Removed : Boolean := False; - Location : Source_Ptr := No_Location) + Alternate_Languages : Language_List := null; + Unit : Name_Id := No_Name; + Index : Int := 0; + Locally_Removed : Boolean := False; + Location : Source_Ptr := No_Location) is Config : constant Language_Config := Lang_Id.Config; UData : Unit_Index; Add_Src : Boolean; Source : Source_Id; Prev_Unit : Unit_Index := No_Unit_Index; + Source_To_Replace : Source_Id := No_Source; begin @@ -619,12 +620,12 @@ package body Prj.Nmsc is end if; end if; - -- Do not allow the same unit name in different projects, - -- except if one is extending the other. + -- Do not allow the same unit name in different projects, except + -- if one is extending the other. - -- For a file based language, the same file name replaces - -- a file in a project being extended, but it is allowed - -- to have the same file name in unrelated projects. + -- For a file based language, the same file name replaces a file + -- in a project being extended, but it is allowed to have the same + -- file name in unrelated projects. elsif Is_Extending (Project, Source.Project) then if not Locally_Removed then diff --git a/gcc/ada/prj-strt.ads b/gcc/ada/prj-strt.ads index 0f6d0d0..7dbe530 100644 --- a/gcc/ada/prj-strt.ads +++ b/gcc/ada/prj-strt.ads @@ -37,10 +37,10 @@ private package Prj.Strt is -- On entry, the current token is the first literal string following -- a left parenthesis in a string type declaration such as: -- type Toto is ("string_1", "string_2", "string_3"); - -- On exit, the current token is the right parenthesis. - -- The parameter First_String is a node that contained the first - -- literal string of the string type, linked with the following - -- literal strings. + -- + -- On exit, the current token is the right parenthesis. The parameter + -- First_String is a node that contained the first literal string of the + -- string type, linked with the following literal strings. -- -- Report an error if -- - a literal string is not found at the beginning of the list @@ -50,24 +50,22 @@ private package Prj.Strt is procedure Start_New_Case_Construction (In_Tree : Project_Node_Tree_Ref; String_Type : Project_Node_Id); - -- This procedure is called at the beginning of a case construction - -- The parameter String_Type is the node for the string type - -- of the case label variable. - -- The different literal strings of the string type are stored - -- into a table to be checked against the case labels of the - -- case construction. + -- This procedure is called at the beginning of a case construction The + -- parameter String_Type is the node for the string type of the case label + -- variable. The different literal strings of the string type are stored + -- into a table to be checked against the case labels of the case + -- construction. procedure End_Case_Construction (Check_All_Labels : Boolean; Case_Location : Source_Ptr; Flags : Processing_Flags); - -- This procedure is called at the end of a case construction - -- to remove the case labels and to restore the previous state. - -- In particular, in the case of nested case constructions, - -- the case labels of the enclosing case construction are restored. - -- When When_Others is False and we are not in quiet output, a warning - -- is emitted for each value of the case variable string type that has - -- not been specified. + -- This procedure is called at the end of a case construction to remove the + -- case labels and to restore the previous state. In particular, in the + -- case of nested case constructions, the case labels of the enclosing case + -- construction are restored. When When_Others is False and we are not in + -- quiet output, a warning is emitted for each value of the case variable + -- string type that has not been specified. procedure Parse_Choice_List (In_Tree : Project_Node_Tree_Ref; @@ -86,12 +84,13 @@ private package Prj.Strt is Current_Package : Project_Node_Id; Optional_Index : Boolean; Flags : Processing_Flags); - -- Parse a simple string expression or a string list expression. - -- Current_Project is the node of the project file being parsed. - -- Current_Package is the node of the package being parsed, - -- or Empty_Node when we are at the project level (not in a package). - -- On exit, Expression is the node of the expression that has - -- been parsed. + -- Parse a simple string expression or a string list expression + -- + -- Current_Project is the node of the project file being parsed + -- + -- Current_Package is the node of the package being parsed, or Empty_Node + -- when we are at the project level (not in a package). On exit, Expression + -- is the node of the expression that has been parsed. procedure Parse_Variable_Reference (In_Tree : Project_Node_Tree_Ref; @@ -99,13 +98,12 @@ private package Prj.Strt is Current_Project : Project_Node_Id; Current_Package : Project_Node_Id; Flags : Processing_Flags); - -- Parse a variable or attribute reference. - -- Used internally (in expressions) and for case variables (in Prj.Dect). - -- Current_Package is the node of the package being parsed, - -- or Empty_Node when we are at the project level (not in a package). - -- On exit, Variable is the node of the variable or attribute reference. - -- A variable reference is made of one to three simple names. - -- An attribute reference is made of one or two simple names, + -- Parse variable or attribute reference. Used internally (in expressions) + -- and for case variables (in Prj.Dect). Current_Package is the node of the + -- package being parsed, or Empty_Node when we are at the project level + -- (not in a package). On exit, Variable is the node of the variable or + -- attribute reference. A variable reference is made of one to three simple + -- names. An attribute reference is made of one or two simple names, -- followed by an apostrophe, followed by the attribute simple name. end Prj.Strt; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 27ee5f0..ff2e01f 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -1362,12 +1362,13 @@ package Prj is -- - Error: issue an error, causes the tool to fail type Error_Handler is access procedure - (Project : Project_Id; Is_Warning : Boolean); + (Project : Project_Id; + Is_Warning : Boolean); -- This warngs when an error was found when parsing a project. The error - -- itself is handled through Prj.Err (and you should call - -- Prj.Err.Finalize to actually print the error). This ensures that - -- duplicate error messages are always correctly removed, that errors msgs - -- are sorted, and that all tools will report the same error to the user. + -- itself is handled through Prj.Err (and Prj.Err.Finalize should be called + -- to actually print the error). This ensures that duplicate error messages + -- are always correctly removed, that errors msgs are sorted, and that all + -- tools will report the same error to the user. function Create_Flags (Report_Error : Error_Handler; diff --git a/gcc/ada/symbols-processing-vms-ia64.adb b/gcc/ada/symbols-processing-vms-ia64.adb index 0eb1af7..beb099e 100644 --- a/gcc/ada/symbols-processing-vms-ia64.adb +++ b/gcc/ada/symbols-processing-vms-ia64.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2009, 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- -- @@ -85,9 +85,14 @@ package body Processing is Stname : Integer; Stinfo : Character; + Stother : Character; Sttype : Integer; Stbind : Integer; Stshndx : Integer; + Stvis : Integer; + + STV_Internal : constant := 1; + STV_Hidden : constant := 2; Section_Headers : Section_Header_Ptr; @@ -340,7 +345,7 @@ package body Processing is while Offset < End_Symtab loop Get_Word (Stname); Get_Byte (Stinfo); - Get_Byte (B); + Get_Byte (Stother); Get_Half (Stshndx); for J in 1 .. 4 loop Get_Word (W); @@ -348,10 +353,13 @@ package body Processing is Sttype := Integer'(Character'Pos (Stinfo)) mod 16; Stbind := Integer'(Character'Pos (Stinfo)) / 16; + Stvis := Integer'(Character'Pos (Stother)) mod 4; if (Sttype = 1 or else Sttype = 2) and then Stbind /= 0 and then Stshndx /= 0 + and then Stvis /= STV_Internal + and then Stvis /= STV_Hidden then -- Check if this is a symbol from a generic body |