Bug 23390 - abstract function in private part not overloading previous function is not allowed
Summary: abstract function in private part not overloading previous function is not al...
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: ada (show other bugs)
Version: 4.0.1
: P2 normal
Target Milestone: ---
Assignee: Not yet assigned to anyone
URL:
Keywords:
Depends on:
Blocks:
 
Reported: 2005-08-14 21:01 UTC by Gary Barnes
Modified: 2008-11-17 20:15 UTC (History)
1 user (show)

See Also:
Host:
Target:
Build: i686-pc-cygwin
Known to work:
Known to fail:
Last reconfirmed:


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description Gary Barnes 2005-08-14 21:01:08 UTC
Unit one.1.ada should not have compiled.  RM 3.9.3(10.

For an abstract type declared in a visible part, an abstract
primitive subprogram shall not be declared in the private part, unless
it is overriding an abstract subprogram implicitly declared in the
visible part.

-------------------------------------------------------------------------------

Using built-in specs.
Target: i686-pc-cygwin
Configured with: ../gcc-4.0.1/configure --prefix=/a/projects/gcc --enable-
languages=ada,c,c++
Thread model: single
gcc version 4.0.1

Built using CYGWIN on a Windows laptop.

------------------------------------------------------------------------------

lap-67: ls -al
total 8
drwxrwxr-x+  2 geb None    0 Aug 14 13:57 .
drwxrwxrwx+ 12 geb None    0 Aug 14 13:37 ..
-rw-rw-r--   1 geb None 3909 Aug 11 22:29 common.gpr
-rw-rw-r--   1 geb None  331 Aug 14 13:51 one.1.ada
-rw-rw-r--   1 geb None  312 Aug 14 13:51 one.two.1.ada
-rw-rw-r--   1 geb None  228 Aug 14 13:52 one.two.2.ada
-rw-rw-r--   1 geb None  460 Aug 14 13:49 three.2.ada
lap-68: gnat make -P common.gpr three.2.ada
gcc -c -gnata -gnatE -fstack-check -gnatf -gnatm100 -gnatn -gnato -gnatU -
gnatwa -gnatwe -gnatwi -gnatwj -gnatwK -gnatwl -Wuninitialized -gnatVa -pass-
exit-codes -O -g -I- -gnatA -x ada /home/geb/foo.dir/three.2.ada
gcc -c -gnata -gnatE -fstack-check -gnatf -gnatm100 -gnatn -gnato -gnatU -
gnatwa -gnatwe -gnatwi -gnatwj -gnatwK -gnatwl -Wuninitialized -gnatVa -pass-
exit-codes -O -g -I- -gnatA -x ada /home/geb/foo.dir/one.1.ada
gcc -c -gnata -gnatE -fstack-check -gnatf -gnatm100 -gnatn -gnato -gnatU -
gnatwa -gnatwe -gnatwi -gnatwj -gnatwK -gnatwl -Wuninitialized -gnatVa -pass-
exit-codes -O -g -I- -gnatA -x ada /home/geb/foo.dir/one.two.2.ada
gnatbind -E -m50 -Sin -static -we -v -I- -x /home/geb/foo.dir/three.2.ali

GNATBIND 4.0.1
Copyright 1995-2005 Free Software Foundation, Inc.

Binding: three.2.ali

No errors
gnatlink /home/geb/foo.dir/three.2.ali -g -o /home/geb/foo.dir/three
lap-69: ./three
Start
I1 128
I2 128
Finish
lap-70: 

Unit one.1.ada should not have compiled.

------------------------------------------------------------------------------
common.gpr
------------------------------------------------------------------------------
project Common is       
    
    for Exec_Dir    use ".";
    for Languages   use ( "Ada" );
    for Object_Dir  use ".";
    for Source_Dirs use (".");

    package Binder is
        for Default_Switches ("Ada")
           use ("-E",               -- store stack backtrace on raise
                "-m50",             -- max errors    
                "-Sin",             -- pragma Initialize_Scalars, use inv. val.
                "-static",          -- use static GNAT runtimes
                "-we",              -- warnings are errors
                "-v"                -- verbose output
               );
    end Binder;

    package Builder is  
        for Default_Switches ("Ada") use ();
        for Global_Configuration_Pragmas use "";
        for Executable_Suffix use "";
    end Builder;

    package Compiler is
        for Default_Switches ("Ada")    
           use (
-- is default   "-c",               -- create .o file
                "-gnata",           -- pragma Assert
                "-gnatE",           -- full elab checks
                "-fstack-check",    -- real stack checking
                "-gnatf",           -- full errors
                "-gnatm100",        -- max errors
                "-gnatn",           -- Allow inlines
                "-gnato",           -- numeric ovfl chk
-- ASIS         "-gnatt",           -- ASIS/tree file
-- annoying     "-gnatu",           -- list unit names
                "-gnatU",           -- errors say error:
--                "-gnatv",           -- verbose on errors and more sigh
-- not on Cygwin "-gnatZ",           -- 0 cost exceptions
                "-gnatwa",          -- all warnings
                "-gnatwe",          -- warning==error
-- does not work well   "-gnatwh",          -- hiding warnings
                "-gnatwi",          -- implem. units
                "-gnatwj",          -- obsolete features
                "-gnatwK",          -- don't bother me about possible constants
                "-gnatwl",          -- elab warnings
                "-Wuninitialized",  -- uninit vars
                "-gnatVa",          -- all validity chks
                "-pass-exit-codes", -- tell me about errors
                "-O",               -- try to optimize some
                "-g"                -- debugging
               );   
        for Local_Configuration_Pragmas use "";
    end Compiler;

    package Cross_Reference is
        for Default_Switches ("Ada")
           use ("-a",               -- do everything, not just locals
                "-d",               -- reference parent types for deriveds
                "-f"                -- output full file paths
--              "-u"                -- only output unused symbols
               );
    end Cross_Reference;

    package Finder is
        for Default_Switches ("Ada")
           use ("-a",               -- do everything, not just locals   
                "-d",               -- reference parent types for deriveds
                "-f");
    end Finder;

    package gnatls is
        for Switches use ("-a",     -- do everything, not just locals
                          "-v"      -- verbose information
                         );
    end gnatls;

    package Linker is
        for Default_Switches ("Ada")
           use (
-- not on Cygwin "-f",               -- put list of files into a file    
                "-g"               -- we want debugging
--                "-v",               -- be very verbose
--                "-v"
               );
    end Linker;

    package Naming is   
        for Casing                  use "lowercase";    
        for Dot_Replacement         use ".";    
        for Spec_Suffix     ("Ada") use ".1.ada";   
        for Body_Suffix     ("Ada") use ".2.ada";   
        for Separate_Suffix         use ".3.ada";
    end Naming;

end Common; 

-- Local Variables:
-- mode: adp-mode
-- End: 

------------------------------------------------------------------------------
one.1.ada
------------------------------------------------------------------------------
generic
    type Int_T is range <>;
package One is

    type Type_T (<>) is abstract tagged private;

    function Init return Type_T is abstract;

private

    function Func (X : in Type_T) return Type_T is abstract;
--  3.9.3(10) - The declaration above is illegal.
--
--  10 For an abstract type declared in a visible part, an abstract
--  primitive subprogram shall not be declared in the private part, unless
--  it is overriding an abstract subprogram implicitly declared in the
--  visible part. For a tagged type declared in a visible part, a primitive
--  function with a controlling result shall not be declared in the private
--  part, unless it is overriding a function implicitly declared in the
--  visible part.

    type Type_T (A : Int_T) is abstract tagged
       record
           B : Int_T;
       end record;

end One;
------------------------------------------------------------------------------
one.two.1.ada
------------------------------------------------------------------------------
generic
    I : Integer;
package One.Two is

    type Type2_T is new One.Type_T with private;

    J : constant Integer := I;

    function Init return Type2_T;
    function Func (X : in Type2_T) return Type2_T;

private

    type Type2_T is new One.Type_T with record Q : Natural := 0; end record;
end One.Two;
------------------------------------------------------------------------------
one.two.2.ada
------------------------------------------------------------------------------
package body One.Two is

    function Init return Type2_T is
    begin
        return (A=>1,B=>2,Q=>3);
    end Init;

    function Func (X : in Type2_T) return Type2_T is
    begin
        return X;
    end Func;

end One.Two;
------------------------------------------------------------------------------
three.2.ada
------------------------------------------------------------------------------
with One.Two;
with Ada.Text_Io;
procedure Three is
    package Onee is new One (Integer);
    package Twoo is new Onee.Two (3);
begin

    Ada.Text_Io.Put_Line ("Start");
    declare
        I1 : Twoo.Type2_T := Twoo.Init;
        I2 : Twoo.Type2_T := Twoo.Func (I1);
    begin
        Ada.Text_Io.Put_Line ("I1" & Integer'Image(I1'Size));
        Ada.Text_Io.Put_Line ("I2" & Integer'Image(I2'Size));
    end;
    Ada.Text_Io.Put_Line ("Finish");

end Three;
------------------------------------------------------------------------------
Comment 1 Samuel Tardieu 2008-11-17 20:15:56 UTC
This is fixed in GCC 4.4.0 and gives the expected error.

GNAT 4.4.0 20081116 (experimental)
Copyright 1992-2008, Free Software Foundation, Inc.

Compiling: three.adb (source file time stamp: 2008-11-17 20:14:51)

==============Error messages for source file: one.ads
    11.     function Func (X : in Type_T) return Type_T is abstract;
                     |
        >>> abstract subprograms must be visible (RM 3.9.3(10))