From 469fba4ae8a7ebfb93fedc446197787087222c6a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 17 Oct 2014 10:29:23 +0200 Subject: [PATCH] [multiple changes] 2014-10-17 Robert Dewar * lib-writ.ads, s-valdec.ads: Minor reformatting. 2014-10-17 Ed Schonberg * sem_ch12.adb: Additional work on function wrappers. 2014-10-17 Eric Botcazou * exp_util.adb (Possible_Bit_Aligned_Component): Also recurse on the renamed object of renamings. 2014-10-17 Vincent Celier * prj-conf.adb (Parse_Project_And_Apply_Config): In CodePeer mode, always use the native target. From-SVN: r216368 --- gcc/ada/ChangeLog | 18 ++++++++++++++++++ gcc/ada/exp_util.adb | 12 ++++++++++-- gcc/ada/lib-writ.ads | 8 ++++---- gcc/ada/prj-conf.adb | 10 ++++++++++ gcc/ada/s-valdec.ads | 15 ++++++++------- gcc/ada/sem_ch12.adb | 23 +++++++++++++++++++---- 6 files changed, 69 insertions(+), 17 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fb64713..60705ed 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2014-10-17 Robert Dewar + + * lib-writ.ads, s-valdec.ads: Minor reformatting. + +2014-10-17 Ed Schonberg + + * sem_ch12.adb: Additional work on function wrappers. + +2014-10-17 Eric Botcazou + + * exp_util.adb (Possible_Bit_Aligned_Component): Also recurse + on the renamed object of renamings. + +2014-10-17 Vincent Celier + + * prj-conf.adb (Parse_Project_And_Apply_Config): In CodePeer + mode, always use the native target. + 2014-10-16 Andrew MacLeod * gcc-interface/misc.c: Adjust include files. diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index d7f200f..562a54d 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6884,10 +6884,18 @@ package body Exp_Util is -- If we have none of the above, it means that we have fallen off the -- top testing prefixes recursively, and we now have a stand alone - -- object, where we don't have a problem. + -- object, where we don't have a problem, unless this is a renaming, + -- in which case we need to look into the renamed object. when others => - return False; + if Is_Entity_Name (N) + and then Present (Renamed_Object (Entity (N))) + then + return + Possible_Bit_Aligned_Component (Renamed_Object (Entity (N))); + else + return False; + end if; end case; end Possible_Bit_Aligned_Component; diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads index 91c16c0..f67e337 100644 --- a/gcc/ada/lib-writ.ads +++ b/gcc/ada/lib-writ.ads @@ -375,10 +375,10 @@ package Lib.Writ is -- RN - -- In named notation, the restrictions are given as a series of lines, one - -- per retrictions that is specified or violated (no information is present - -- for restrictions that are not specified or violated). In the following - -- name is the name of the restriction in all upper case. + -- In named notation, the restrictions are given as a series of lines, + -- one per restrictions that is specified or violated (no information is + -- present for restrictions that are not specified or violated). In the + -- following name is the name of the restriction in all upper case. -- For boolean restrictions, we have only two possibilities. A restrictions -- pragma is present, or a violation is detected: diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index fe1be8f..dff0642 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -1592,6 +1592,16 @@ package body Prj.Conf is Main_Project := No_Project; Automatically_Generated := False; + -- Need a comment here saying why CodePeer mode is different ??? + + if CodePeer_Mode or else Target_Name = "" then + Opt.Target_Value := new String'(Normalized_Hostname); + Opt.Target_Origin := Default; + else + Opt.Target_Value := new String'(Target_Name); + Opt.Target_Origin := Specified; + end if; + Prj.Part.Parse (In_Tree => Project_Node_Tree, Project => User_Project_Node, diff --git a/gcc/ada/s-valdec.ads b/gcc/ada/s-valdec.ads index cb7a731..71c9812 100644 --- a/gcc/ada/s-valdec.ads +++ b/gcc/ada/s-valdec.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-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- -- @@ -69,11 +69,12 @@ package System.Val_Dec is -- is greater than Max as required in this case. function Value_Decimal (Str : String; Scale : Integer) return Integer; - -- Used in computing X'Value (Str) where X is a decimal types whose size - -- does not exceed Standard.Integer'Size. Str is the string argument of - -- the attribute. Constraint_Error is raised if the string is malformed - -- or if the value is out of range, otherwise the value returned is the - -- value Integer'Integer_Value (decimal-literal-value), using the given - -- Scale to determine this value. + -- Used in computing X'Value (Str) where X is a decimal fixed-point type + -- whose size does not exceed Standard.Integer'Size. Str is the string + -- argument of the attribute. Constraint_Error is raised if the string + -- is malformed or if the value is out of range of Integer (not the + -- range of the fixed-point type, that check must be done by the caller. + -- Otherwise the value returned is the value Integer'Integer_Value + -- (decimal-literal-value), using Scale to determine this value. end System.Val_Dec; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index d88dcc2..9f516fe 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1033,7 +1033,8 @@ package body Sem_Ch12 is Func_Name : Node_Id; Func : Entity_Id; N_Parms : Natural; - Profile : List_Id; + Parm_Type : Node_Id; + Profile : List_Id := New_List; Spec : Node_Id; F : Entity_Id; New_F : Entity_Id; @@ -1055,7 +1056,7 @@ package body Sem_Ch12 is Actuals := New_List; Profile := New_List; - F := First_Formal (Formal); + F := First_Formal (Entity (Actual)); N_Parms := 0; while Present (F) loop @@ -1064,11 +1065,25 @@ package body Sem_Ch12 is New_F := Make_Temporary (Loc, Character'Val (Character'Pos ('A') + N_Parms)); + + -- If a formal has a class-wide type, rewrite as the corresponding + -- attribute, because the class-wide type is not retrievable by + -- visbility. + + if Is_Class_Wide_Type (Etype (F)) then + Parm_Type := + Make_Attribute_Reference (Loc, + Attribute_Name => Name_Class, + Prefix => + Make_Identifier (Loc, Chars (Etype (Etype (F))))); + else + Parm_Type := Make_Identifier (Loc, Chars (Etype (F))); + end if; + Append_To (Profile, Make_Parameter_Specification (Loc, Defining_Identifier => New_F, - Parameter_Type => - Make_Identifier (Loc, Chars => Chars (Etype (F))))); + Parameter_Type => Parm_Type)); Append_To (Actuals, New_Occurrence_Of (New_F, Loc)); Next_Formal (F); -- 2.7.4