From 24558db881d2789475da76d93a4e1369502ab867 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 4 Aug 2011 15:59:40 +0200 Subject: [PATCH] [multiple changes] 2011-08-04 Yannick Moy * sem_ch3.adb, sem_ch5.adb, sem_util.adb, sem_ch4.adb, sem_ch8.adb, opt.ads, lib-xref.ads: Code clean up. 2011-08-04 Yannick Moy * gnat_rm.texi: Update description of Test_Case * gnat_ugn.texi: Typo. 2011-08-04 Ed Falis * adaint.c (__gnat_get_number_of_cpus): fix typo in last checkin. 2011-08-04 Hristian Kirtchev * exp_ch4.adb (Suitable_Element): Skip field _parent on .NET/JVM when it is of type Root_Controlled. This action eliminates fields Prev and Next from type equality. 2011-08-04 Yannick Moy * lib-xref-alfa.adb: Correct typo. 2011-08-04 Matthew Heaney * a-cohata.ads (Hash_Table_Type): default-initialize the Nodes component. From-SVN: r177390 --- gcc/ada/ChangeLog | 29 +++++++++++++++++++++++++++++ gcc/ada/a-cohata.ads | 4 ++-- gcc/ada/adaint.c | 2 +- gcc/ada/exp_ch4.adb | 11 +++++++++++ gcc/ada/gnat_rm.texi | 13 +++++++++++-- gcc/ada/gnat_ugn.texi | 2 +- gcc/ada/lib-xref-alfa.adb | 2 +- gcc/ada/lib-xref.ads | 1 - gcc/ada/opt.ads | 3 --- gcc/ada/sem_ch3.adb | 2 +- gcc/ada/sem_ch4.adb | 2 +- gcc/ada/sem_ch5.adb | 2 +- gcc/ada/sem_ch8.adb | 4 ++-- gcc/ada/sem_util.adb | 2 +- 14 files changed, 62 insertions(+), 17 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 01ac7c31ccb..d22593d3401 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2011-08-04 Yannick Moy + + * sem_ch3.adb, sem_ch5.adb, sem_util.adb, sem_ch4.adb, sem_ch8.adb, + opt.ads, lib-xref.ads: Code clean up. + +2011-08-04 Yannick Moy + + * gnat_rm.texi: Update description of Test_Case + * gnat_ugn.texi: Typo. + +2011-08-04 Ed Falis + + * adaint.c (__gnat_get_number_of_cpus): fix typo in last checkin. + +2011-08-04 Hristian Kirtchev + + * exp_ch4.adb (Suitable_Element): Skip field _parent on .NET/JVM when + it is of type Root_Controlled. This action eliminates fields Prev and + Next from type equality. + +2011-08-04 Yannick Moy + + * lib-xref-alfa.adb: Correct typo. + +2011-08-04 Matthew Heaney + + * a-cohata.ads (Hash_Table_Type): default-initialize the Nodes + component. + 2011-08-04 Yannick Moy * sem_prag.adb (Check_Arg_Is_String_Literal): remove useless procedure diff --git a/gcc/ada/a-cohata.ads b/gcc/ada/a-cohata.ads index d935447b25b..2a6c6ab5706 100644 --- a/gcc/ada/a-cohata.ads +++ b/gcc/ada/a-cohata.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2011, 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- -- @@ -66,7 +66,7 @@ package Ada.Containers.Hash_Tables is Busy : Natural := 0; Lock : Natural := 0; Free : Count_Type'Base := -1; - Nodes : Nodes_Type (1 .. Capacity); + Nodes : Nodes_Type (1 .. Capacity) := (others => <>); Buckets : Buckets_Type (1 .. Modulus) := (others => 0); end record; end Generic_Bounded_Hash_Table_Types; diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index a5cc29c4732..ab8446def35 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -2448,7 +2448,7 @@ __gnat_number_of_cpus (void) if ((status & 1) != 0) cores = res; -#elif defined (__WRS_CONFIG_SMP) +#elif defined (_WRS_CONFIG_SMP) unsigned int vxCpuConfiguredGet (void); cores = vxCpuConfiguredGet (); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 0a9ddb1c336..9acc3e4fa8c 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -9328,6 +9328,17 @@ package body Exp_Ch4 is elsif Chars (C) = Name_uTag then return Suitable_Element (Next_Entity (C)); + -- The .NET/JVM version of type Root_Controlled contains two fields + -- which should not be considered part of the object. To achieve + -- proper equiality between two controlled objects on .NET/JVM, skip + -- field _parent whenever it is of type Root_Controlled. + + elsif Chars (C) = Name_uParent + and then VM_Target /= No_VM + and then Etype (C) = RTE (RE_Root_Controlled) + then + return Suitable_Element (Next_Entity (C)); + elsif Is_Interface (Etype (C)) then return Suitable_Element (Next_Entity (C)); diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 8c22975c42c..1cfcf715960 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -5018,7 +5018,7 @@ Syntax: @smallexample @c ada pragma Test_Case ( - [Name =>] String_Expression + [Name =>] static_string_Expression ,[Mode =>] (Normal | Robustness) [, Requires => Boolean_Expression] [, Ensures => Boolean_Expression]); @@ -5047,7 +5047,7 @@ expression. The following is an example of use within a package spec: package Math_Functions is ... function Sqrt (Arg : Float) return Float; - pragma Test_Case (Name => ``Test_1``, + pragma Test_Case (Name => "Test 1", Mode => Normal, Requires => Arg < 100, Ensures => Sqrt'Result < 10); @@ -5055,6 +5055,15 @@ package Math_Functions is end Math_Functions; @end smallexample +@noindent +The meaning of a test case is that, if the associated subprogram is +executed in a context where @code{Requires} holds, then @code{Ensures} +should hold when the subprogram returns. Mode @code{Normal} indicates +that the input context should satisfy the normal precondition of the +subprogram, and the output context should then satisfy its +postcondition. More @code{Robustness} indicates that the normal pre- and +postcondition of the subprogram should be ignored for this test case. + @node Pragma Thread_Local_Storage @unnumberedsec Pragma Thread_Local_Storage @findex Thread_Local_Storage diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index d45a6fc3aa3..3e689938cdd 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -17285,7 +17285,7 @@ much has actually been used. The environment task stack, e.g., the stack that contains the main unit, is only processed when the environment variable GNAT_STACK_LIMIT is set. -@noident +@noindent The package @code{GNAT.Task_Stack_Usage} provides facilities to get stack usage reports at run-time. See its body for the details. diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb index 0e0a4ff2973..9b78b438562 100644 --- a/gcc/ada/lib-xref-alfa.adb +++ b/gcc/ada/lib-xref-alfa.adb @@ -546,7 +546,7 @@ package body ALFA is function Is_Global_Constant (E : Entity_Id) return Boolean is begin - return Ekind (E) in E_Constant + return Ekind (E) = E_Constant and then Ekind_In (Scope (E), E_Package, E_Package_Body); end Is_Global_Constant; diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index 5ddc273cf52..ecee22a3377 100644 --- a/gcc/ada/lib-xref.ads +++ b/gcc/ada/lib-xref.ads @@ -177,7 +177,6 @@ package Lib.Xref is -- e = end of spec -- H = abstract type -- i = implicit reference - -- I = object definition with initialization -- k = implicit reference to parent unit in child unit -- l = label on END line -- m = modification diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 3eaa855358d..ec121360007 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1878,9 +1878,6 @@ package Opt is -- the generation of Why code for those parts of the input code that -- belong to the ALFA subset of Ada. Set by debuf flag -gnatd.F. - SPARK_Mode : Boolean := False; - -- Reject constructs not allowed by SPARK. Set by flag -gnatd.D. - private -- The following type is used to save and restore settings of switches in diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 53ba892bd8e..4e8ae6d6a57 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2057,7 +2057,7 @@ package body Sem_Ch3 is -- Start of processing for Analyze_Declarations begin - if SPARK_Mode or else Restriction_Check_Required (SPARK) then + if Restriction_Check_Required (SPARK) then Check_Later_Vs_Basic_Declarations (L, During_Parsing => False); end if; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index f1b53fca670..276c2843274 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -881,7 +881,7 @@ package body Sem_Ch4 is -- Start of processing for Analyze_Call begin - if SPARK_Mode or else Restriction_Check_Required (SPARK) then + if Restriction_Check_Required (SPARK) then Check_Mixed_Parameter_And_Named_Associations; end if; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 3597f793b90..2e4adcde4a9 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2620,7 +2620,7 @@ package body Sem_Ch5 is -- Now issue the warning (or error in formal mode) - if SPARK_Mode or else Restriction_Check_Required (SPARK) then + if Restriction_Check_Required (SPARK) then Check_SPARK_Restriction ("unreachable code is not allowed", Error_Node); else diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 68ba0309b14..9c770019470 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -5572,7 +5572,7 @@ package body Sem_Ch8 is -- Selector name cannot be a character literal or an operator symbol in -- SPARK, except for the operator symbol in a renaming. - if SPARK_Mode or else Restriction_Check_Required (SPARK) then + if Restriction_Check_Required (SPARK) then if Nkind (Selector_Name (N)) = N_Character_Literal then Check_SPARK_Restriction ("character literal cannot be prefixed", N); @@ -5911,7 +5911,7 @@ package body Sem_Ch8 is -- Selector name is restricted in SPARK if Nkind (N) = N_Expanded_Name - and then (SPARK_Mode or else Restriction_Check_Required (SPARK)) + and then Restriction_Check_Required (SPARK) then if Is_Subprogram (P_Name) then Check_SPARK_Restriction diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 0c36811ec5b..b7b8fe01a6f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -11022,7 +11022,7 @@ package body Sem_Util is -- subprogram bodies. Detect those cases by testing whether -- Process_End_Label was called for a body (Typ = 't') or a package. - if (SPARK_Mode or else Restriction_Check_Required (SPARK)) + if Restriction_Check_Required (SPARK) and then (Typ = 't' or else Ekind (Ent) = E_Package) then Error_Msg_Node_1 := Endl; -- 2.30.2