From 496b8337d4f5c335672ec74e0091cae1d93f3aac Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 14 Oct 2011 15:12:32 +0000 Subject: [PATCH] 2011-10-14 Ed Schonberg * exp_disp.adb (Check_Premature_Freezing): If an untagged type is a generic actual, it is a subtype of a type that was frozen by the instantiation, and even if not marked frozen it does not affect the construction of the dispatch table. 2011-10-14 Robert Dewar * make.adb, mlib-utl.adb, sem_util.adb, sem_ch4.adb: Minor code reformatting. * s-rident.ads: Add missing Compiler_Unit pragma. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@179989 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 13 ++++++++ gcc/ada/exp_disp.adb | 4 +++ gcc/ada/make.adb | 2 +- gcc/ada/mlib-utl.adb | 5 ++-- gcc/ada/s-rident.ads | 2 ++ gcc/ada/sem_ch4.adb | 84 +++++++++++++++++++++++++--------------------------- gcc/ada/sem_util.adb | 5 ++-- 7 files changed, 65 insertions(+), 50 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4c64e56..5ca9b97 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2011-10-14 Ed Schonberg + + * exp_disp.adb (Check_Premature_Freezing): If an untagged type + is a generic actual, it is a subtype of a type that was frozen + by the instantiation, and even if not marked frozen it does not + affect the construction of the dispatch table. + +2011-10-14 Robert Dewar + + * make.adb, mlib-utl.adb, sem_util.adb, sem_ch4.adb: Minor code + reformatting. + * s-rident.ads: Add missing Compiler_Unit pragma. + 2011-10-14 Gary Dismukes * sem_res.adb: Minor reformatting. diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 5f9cd83..2174528 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -3771,12 +3771,16 @@ package body Exp_Disp is -- Start of processing for Check_Premature_Freezing begin + -- Note that if the type is a (subtype of) a generic actual, the + -- actual will have been frozen by the instantiation. + if Present (N) and then Is_Private_Type (Typ) and then No (Full_View (Typ)) and then not Is_Generic_Type (Typ) and then not Is_Tagged_Type (Typ) and then not Is_Frozen (Typ) + and then not Is_Generic_Actual_Type (Typ) then Error_Msg_Sloc := Sloc (Subp); Error_Msg_NE diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index bf6a21a..9204348 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -4603,7 +4603,7 @@ package body Make is procedure Library_Phase (Stand_Alone_Libraries : in out Boolean; - Library_Rebuilt : in out Boolean) + Library_Rebuilt : in out Boolean) is Depth : Natural; Current : Natural; diff --git a/gcc/ada/mlib-utl.adb b/gcc/ada/mlib-utl.adb index 67e0309..215fa5d 100644 --- a/gcc/ada/mlib-utl.adb +++ b/gcc/ada/mlib-utl.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2002-2010, AdaCore -- +-- Copyright (C) 2002-2011, AdaCore -- -- -- -- 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- -- @@ -553,8 +553,7 @@ package body MLib.Utl is Write_RF (Opening'Address, 1); end if; - Write_RF - (Objects (J).all'Address, Objects (J).all'Length); + Write_RF (Objects (J).all'Address, Objects (J).all'Length); -- Closing quote for GNU linker diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index dd9ef16..1c306e3 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -41,6 +41,8 @@ -- so we can do the instantiation under control of Discard_Names to remove -- the tables. +pragma Compiler_Unit; + generic package System.Rident is pragma Preelaborate; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ba60024..efc76f1 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3114,63 +3114,61 @@ package body Sem_Ch4 is if Present (Next_Actual (Act2)) then return; + end if; - elsif Op_Name = Name_Op_Add - or else Op_Name = Name_Op_Subtract - or else Op_Name = Name_Op_Multiply - or else Op_Name = Name_Op_Divide - or else Op_Name = Name_Op_Mod - or else Op_Name = Name_Op_Rem - or else Op_Name = Name_Op_Expon - then - Find_Arithmetic_Types (Act1, Act2, Op_Id, N); + -- Otherwise action depends on operator - elsif Op_Name = Name_Op_And - or else Op_Name = Name_Op_Or - or else Op_Name = Name_Op_Xor - then - Find_Boolean_Types (Act1, Act2, Op_Id, N); + case Op_Name is + when Name_Op_Add | + Name_Op_Subtract | + Name_Op_Multiply | + Name_Op_Divide | + Name_Op_Mod | + Name_Op_Rem | + Name_Op_Expon => + Find_Arithmetic_Types (Act1, Act2, Op_Id, N); - elsif Op_Name = Name_Op_Lt - or else Op_Name = Name_Op_Le - or else Op_Name = Name_Op_Gt - or else Op_Name = Name_Op_Ge - then - Find_Comparison_Types (Act1, Act2, Op_Id, N); + when Name_Op_And | + Name_Op_Or | + Name_Op_Xor => + Find_Boolean_Types (Act1, Act2, Op_Id, N); - elsif Op_Name = Name_Op_Eq - or else Op_Name = Name_Op_Ne - then - Find_Equality_Types (Act1, Act2, Op_Id, N); + when Name_Op_Lt | + Name_Op_Le | + Name_Op_Gt | + Name_Op_Ge => + Find_Comparison_Types (Act1, Act2, Op_Id, N); - elsif Op_Name = Name_Op_Concat then - Find_Concatenation_Types (Act1, Act2, Op_Id, N); + when Name_Op_Eq | + Name_Op_Ne => + Find_Equality_Types (Act1, Act2, Op_Id, N); - -- Is this else null correct, or should it be an abort??? + when Name_Op_Concat => + Find_Concatenation_Types (Act1, Act2, Op_Id, N); - else - null; - end if; + -- Is this when others, or should it be an abort??? + + when others => + null; + end case; -- Unary operator case else - if Op_Name = Name_Op_Subtract - or else Op_Name = Name_Op_Add - or else Op_Name = Name_Op_Abs - then - Find_Unary_Types (Act1, Op_Id, N); + case Op_Name is + when Name_Op_Subtract | + Name_Op_Add | + Name_Op_Abs => + Find_Unary_Types (Act1, Op_Id, N); - elsif - Op_Name = Name_Op_Not - then - Find_Negation_Types (Act1, Op_Id, N); + when Name_Op_Not => + Find_Negation_Types (Act1, Op_Id, N); - -- Is this else null correct, or should it be an abort??? + -- Is this when others correct, or should it be an abort??? - else - null; - end if; + when others => + null; + end case; end if; end Analyze_Operator_Call; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index ec0b135..99667d0 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3910,8 +3910,8 @@ package body Sem_Util is end if; end loop; - -- This loop checks the form of the prefix for an entity, - -- using recursion to deal with intermediate components. + -- This loop checks the form of the prefix for an entity, using + -- recursion to deal with intermediate components. loop -- Check for Y where Y is an entity @@ -3925,7 +3925,6 @@ package body Sem_Util is elsif Nkind_In (Expr, N_Selected_Component, N_Indexed_Component) then - Expr := Prefix (Expr); Off := True; -- 2.7.4