about <MSEProperty: #propertySignature type: #Number> <MSEComment: 'ZZZ'>

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
7 messages Options
Reply | Threaded
Open this post in threaded view
|

about <MSEProperty: #propertySignature type: #Number> <MSEComment: 'ZZZ'>

Stéphane Ducasse
I wanted to address the following issue


Look for senders of:

propertySignature
        <property: #XXX longName: 'YYY' description: 'ZZZ'>

And replace with:

propertySignature
        <MSEProperty: #propertySignature type: #Number>
        <MSEComment: 'ZZZ'>

but I do not understand it :(



numberOfMessageSends
        <property: #MSG longName: 'Number of message sends' description:
                        'The number of message from a method'>
       
        ^self
                lookUpPropertyNamed: #MSG
                computedAs:
                        [self mooseModel isSmalltalk
                                ifTrue:
                                        [| parser |
                                        parser := VisualWorksParseTreeMetricCalculator new.
                                        parser processMethod: self usingImporter: nil inModel: nil.
                                        parser numberOfMessageSends]
                                ifFalse: [-1]]


numberOfMessageSends
        <MSEProperty: #numberOfMessageSends
        <MSEComment: 'Number of message sends' description:
                        'The number of message from a method'>
       
        ^self
                lookUpPropertyNamed: #MSG
                computedAs:
                        [self mooseModel isSmalltalk
                                ifTrue:
                                        [| parser |
                                        parser := VisualWorksParseTreeMetricCalculator new.
                                        parser processMethod: self usingImporter: nil inModel: nil.
                                        parser numberOfMessageSends]
                                ifFalse: [-1]]


How does the system know after that the property is linked with #MSG if MSG is not part
        <property: #MSG longName: 'Number of message sends' description: 'The number of message from a method'>

Why do we duplicate the method selector?

why do we create comment as a separate entity. To me it looks like we are looking for complicated queries after.
I still do know how I can get a method containing two tags in one query.

What is the rationale? Why having a comment directly in would be a bad idea.

So guess what? I will wait because fixing the 122 left.

Stef



_______________________________________________
Moose-dev mailing list
[hidden email]
https://www.iam.unibe.ch/mailman/listinfo/moose-dev
Reply | Threaded
Open this post in threaded view
|

Re: about <MSEProperty: #propertySignature type: #Number> <MSEComment: 'ZZZ'>

Tudor Girba-2
Hi,

On 19 Sep 2011, at 09:50, Stéphane Ducasse wrote:

> I wanted to address the following issue
>
>
> Look for senders of:
>
> propertySignature
> <property: #XXX longName: 'YYY' description: 'ZZZ'>
>
> And replace with:
>
> propertySignature
> <MSEProperty: #propertySignature type: #Number>
> <MSEComment: 'ZZZ'>
>
> but I do not understand it :(
>
>
>
> numberOfMessageSends
> <property: #MSG longName: 'Number of message sends' description:
> 'The number of message from a method'>
>
> ^self
> lookUpPropertyNamed: #MSG
> computedAs:
> [self mooseModel isSmalltalk
> ifTrue:
> [| parser |
> parser := VisualWorksParseTreeMetricCalculator new.
> parser processMethod: self usingImporter: nil inModel: nil.
> parser numberOfMessageSends]
> ifFalse: [-1]]
>
>
> numberOfMessageSends
> <MSEProperty: #numberOfMessageSends
> <MSEComment: 'Number of message sends' description:
> 'The number of message from a method'>
>
> ^self
> lookUpPropertyNamed: #MSG
> computedAs:
> [self mooseModel isSmalltalk
> ifTrue:
> [| parser |
> parser := VisualWorksParseTreeMetricCalculator new.
> parser processMethod: self usingImporter: nil inModel: nil.
> parser numberOfMessageSends]
> ifFalse: [-1]]
>
>
> How does the system know after that the property is linked with #MSG if MSG is not part
> <property: #MSG longName: 'Number of message sends' description: 'The number of message from a method'>
>
> Why do we duplicate the method selector?

This is the pragma used by Fame. Essentially, you could theoretically use a different selector for the Fame property than for the actual implementation.

> why do we create comment as a separate entity. To me it looks like we are looking for complicated queries after.

No. The thing is that the comment is optional, and so is the <derived> or <multivalue>. So instead of creating a tone of possible combinations, we use individual annotations and we combine the as needed. This works reasonably well.

> I still do know how I can get a method containing two tags in one query.

We use the crappy Pragma protocol.

For example:
Pragma
                inMethod: FAMIXType>>#attributes
                named: #MSEComment:.

==> <MSEComment: 'List of attributes declared by this type.'>

> What is the rationale? Why having a comment directly in would be a bad idea.

See above.

> So guess what? I will wait because fixing the 122 left.

Sure. Fixing core things is quite straightforward.

Cheers,
Doru



> Stef
>
>
>
> _______________________________________________
> Moose-dev mailing list
> [hidden email]
> https://www.iam.unibe.ch/mailman/listinfo/moose-dev

--
www.tudorgirba.com

"Some battles are better lost than fought."




_______________________________________________
Moose-dev mailing list
[hidden email]
https://www.iam.unibe.ch/mailman/listinfo/moose-dev
Reply | Threaded
Open this post in threaded view
|

Re: about <MSEProperty: #propertySignature type: #Number> <MSEComment: 'ZZZ'>

Stéphane Ducasse
Doru now I understand what I do not understand

When we define afferentCoupling the following way we make sure that the acronym can be used to look for the value?


afferentCoupling
        "Afferent coupling for a class group is the number of classes that depend upon this class group"
       
        <property: #AFFC longName: 'Afferent Coupling' description: 'Afferent Coupling of a class group'>
               
        | cgClasses cgTypes |
        cgClasses := self allClasses select: [:c | c isInstanceSide].
        cgTypes := cgClasses flatCollect: [:c | c allRecursiveTypes].
       
        ^ (cgClasses flatCollect: [:aClass | aClass invokingClasses select: [: c | (cgClasses contains: [:each | each = c]) not and: [(cgTypes contains: [:each | each = c]) not and: [c isInstanceSide]]]]) asSet size

Now if we rewrite it

afferentCoupling
        "Afferent coupling for a class group is the number of classes that depend upon this class group"
       
        <MSEproperty: 'Afferent Coupling' type: #Number>
               
        | cgClasses cgTypes |
        cgClasses := self allClasses select: [:c | c isInstanceSide].
        cgTypes := cgClasses flatCollect: [:c | c allRecursiveTypes].
       
        ^ (cgClasses flatCollect: [:aClass | aClass invokingClasses select: [: c | (cgClasses contains: [:each | each = c]) not and: [(cgTypes contains: [:each | each = c]) not and: [c isInstanceSide]]]]) asSet size


We do not get the fact that this metrics is associated with the #AFFC acronym


So this was my question before rwriting everything.


_______________________________________________
Moose-dev mailing list
[hidden email]
https://www.iam.unibe.ch/mailman/listinfo/moose-dev
Reply | Threaded
Open this post in threaded view
|

Re: about <MSEProperty: #propertySignature type: #Number> <MSEComment: 'ZZZ'>

Tudor Girba-2
Hi Stef,

First, the pragma should be:

<MSEproperty: #afferentCoupling type: #Number>

It's like an identifier in code.

Then the only thing different here is what will be saved in the MSE file. So, instead of AFFC, we will have afferentCoupling.

The only real problem is in the case where we rely on looking up the property in the dictionary before trying to compute it.

Let me give you an example:

FAMIXBehavioralEntity>>numberOfLinesOfCode
   <MSEProperty: #numberOfLinesOfCode type: #Number>
   <MSEComment: 'The number of lines of code in a method.'>
   
   ^ self lookUpPropertyNamed: #LOC computedAs: [...]

In this case, there is a mismatch between what gets looked up in the implementation (#LOC), and what is described (#numberOfLinesOfCode). This is because the current external parsers export the LOC property, but when we are inside Moose, we want to see numberOfLinesOfCode (it reads better, and it scales better given that we tend to have a tone of metrics and acronyms become confusing).

So, after loading a model with LOC properties from MSE, by default, these will get stored in the properties dictionary. Now, we still have the problem that after we save the model and load it again, we will lose the LOC information because now it will be stored with the numberOfLinesOfCode. So, until we fix the external parsers, we can have the following workaround:

FAMIXBehavioralEntity>>numberOfLinesOfCode
   <MSEProperty: #numberOfLinesOfCode type: #Number>
   <MSEComment: 'The number of lines of code in a method.'>
   
   ^ self privateState propertyAt: #LOC ifAbsentPut: [
      "this is to make sure we get #LOC"
      self privateState propertyAt: #numberOfLinesOfCode ifAbsentPut: [
            "this is to deal with the Moose #numberOfLinesOfCode"
             ...] ]


Cheers,
Doru



On 19 Sep 2011, at 19:40, Stéphane Ducasse wrote:

> Doru now I understand what I do not understand
>
> When we define afferentCoupling the following way we make sure that the acronym can be used to look for the value?
>
>
> afferentCoupling
> "Afferent coupling for a class group is the number of classes that depend upon this class group"
>
> <property: #AFFC longName: 'Afferent Coupling' description: 'Afferent Coupling of a class group'>
>
> | cgClasses cgTypes |
> cgClasses := self allClasses select: [:c | c isInstanceSide].
> cgTypes := cgClasses flatCollect: [:c | c allRecursiveTypes].
>
> ^ (cgClasses flatCollect: [:aClass | aClass invokingClasses select: [: c | (cgClasses contains: [:each | each = c]) not and: [(cgTypes contains: [:each | each = c]) not and: [c isInstanceSide]]]]) asSet size
>
> Now if we rewrite it
>
> afferentCoupling
> "Afferent coupling for a class group is the number of classes that depend upon this class group"
>
> <MSEproperty: 'Afferent Coupling' type: #Number>
>
> | cgClasses cgTypes |
> cgClasses := self allClasses select: [:c | c isInstanceSide].
> cgTypes := cgClasses flatCollect: [:c | c allRecursiveTypes].
>
> ^ (cgClasses flatCollect: [:aClass | aClass invokingClasses select: [: c | (cgClasses contains: [:each | each = c]) not and: [(cgTypes contains: [:each | each = c]) not and: [c isInstanceSide]]]]) asSet size
>
>
> We do not get the fact that this metrics is associated with the #AFFC acronym
>
>
> So this was my question before rwriting everything.
>
>
> _______________________________________________
> Moose-dev mailing list
> [hidden email]
> https://www.iam.unibe.ch/mailman/listinfo/moose-dev

--
www.tudorgirba.com

"Problem solving efficiency grows with the abstractness level of problem understanding."




_______________________________________________
Moose-dev mailing list
[hidden email]
https://www.iam.unibe.ch/mailman/listinfo/moose-dev
Reply | Threaded
Open this post in threaded view
|

Re: about <MSEProperty: #propertySignature type: #Number> <MSEComment: 'ZZZ'>

Nicolas Anquetil

Hi,

(trying to follow the discussion here)


Isn't it a mistake to design the whole pragma thing to patch a problem with a few metrics that the exporter computes?

Wouldn't it be simpler to do it "the right way" (whatever it is, but independently of this issue) and them implement a work-around for this specific problem?

How many metrics are they?
How often do they change?

(just asking)

The work-around could be in the mse-importer, or a small processing of the mse before importing it ...

nicolas

----- Mail original -----

> De: "Tudor Girba" <[hidden email]>
> À: "Moose-related development" <[hidden email]>
> Envoyé: Mardi 20 Septembre 2011 09:21:45
> Objet: [Moose-dev] Re: about <MSEProperty: #propertySignature type: #Number> <MSEComment: 'ZZZ'>
> Hi Stef,
>
> First, the pragma should be:
>
> <MSEproperty: #afferentCoupling type: #Number>
>
> It's like an identifier in code.
>
> Then the only thing different here is what will be saved in the MSE
> file. So, instead of AFFC, we will have afferentCoupling.
>
> The only real problem is in the case where we rely on looking up the
> property in the dictionary before trying to compute it.
>
> Let me give you an example:
>
> FAMIXBehavioralEntity>>numberOfLinesOfCode
> <MSEProperty: #numberOfLinesOfCode type: #Number>
> <MSEComment: 'The number of lines of code in a method.'>
>
> ^ self lookUpPropertyNamed: #LOC computedAs: [...]
>
> In this case, there is a mismatch between what gets looked up in the
> implementation (#LOC), and what is described (#numberOfLinesOfCode).
> This is because the current external parsers export the LOC property,
> but when we are inside Moose, we want to see numberOfLinesOfCode (it
> reads better, and it scales better given that we tend to have a tone
> of metrics and acronyms become confusing).
>
> So, after loading a model with LOC properties from MSE, by default,
> these will get stored in the properties dictionary. Now, we still have
> the problem that after we save the model and load it again, we will
> lose the LOC information because now it will be stored with the
> numberOfLinesOfCode. So, until we fix the external parsers, we can
> have the following workaround:
>
> FAMIXBehavioralEntity>>numberOfLinesOfCode
> <MSEProperty: #numberOfLinesOfCode type: #Number>
> <MSEComment: 'The number of lines of code in a method.'>
>
> ^ self privateState propertyAt: #LOC ifAbsentPut: [
> "this is to make sure we get #LOC"
> self privateState propertyAt: #numberOfLinesOfCode ifAbsentPut: [
> "this is to deal with the Moose #numberOfLinesOfCode"
> ...] ]
>
>
> Cheers,
> Doru
>
>
>
> On 19 Sep 2011, at 19:40, Stéphane Ducasse wrote:
>
> > Doru now I understand what I do not understand
> >
> > When we define afferentCoupling the following way we make sure that
> > the acronym can be used to look for the value?
> >
> >
> > afferentCoupling
> > "Afferent coupling for a class group is the number of classes that
> > depend upon this class group"
> >
> > <property: #AFFC longName: 'Afferent Coupling' description:
> > 'Afferent Coupling of a class group'>
> >
> > | cgClasses cgTypes |
> > cgClasses := self allClasses select: [:c | c isInstanceSide].
> > cgTypes := cgClasses flatCollect: [:c | c allRecursiveTypes].
> >
> > ^ (cgClasses flatCollect: [:aClass | aClass invokingClasses select:
> > [: c | (cgClasses contains: [:each | each = c]) not and: [(cgTypes
> > contains: [:each | each = c]) not and: [c isInstanceSide]]]]) asSet
> > size
> >
> > Now if we rewrite it
> >
> > afferentCoupling
> > "Afferent coupling for a class group is the number of classes that
> > depend upon this class group"
> >
> > <MSEproperty: 'Afferent Coupling' type: #Number>
> >
> > | cgClasses cgTypes |
> > cgClasses := self allClasses select: [:c | c isInstanceSide].
> > cgTypes := cgClasses flatCollect: [:c | c allRecursiveTypes].
> >
> > ^ (cgClasses flatCollect: [:aClass | aClass invokingClasses select:
> > [: c | (cgClasses contains: [:each | each = c]) not and: [(cgTypes
> > contains: [:each | each = c]) not and: [c isInstanceSide]]]]) asSet
> > size
> >
> >
> > We do not get the fact that this metrics is associated with the
> > #AFFC acronym
> >
> >
> > So this was my question before rwriting everything.
> >
> >
> > _______________________________________________
> > Moose-dev mailing list
> > [hidden email]
> > https://www.iam.unibe.ch/mailman/listinfo/moose-dev
>
> --
> www.tudorgirba.com
>
> "Problem solving efficiency grows with the abstractness level of
> problem understanding."
>
>
>
>
> _______________________________________________
> Moose-dev mailing list
> [hidden email]
> https://www.iam.unibe.ch/mailman/listinfo/moose-dev

_______________________________________________
Moose-dev mailing list
[hidden email]
https://www.iam.unibe.ch/mailman/listinfo/moose-dev
Reply | Threaded
Open this post in threaded view
|

Re: about <MSEProperty: #propertySignature type: #Number> <MSEComment: 'ZZZ'>

Tudor Girba-2
Hi,

Perhaps there was a misunderstanding. The pragma thing is exactly going to do the right thing at the meta-level :). It is the Smalltalk implementation that will allow for variability until we transition the external parsers to the new names.

In particular, the workaround I propose will only affect a handful of metrics (those that are being exported by the external parsers). The rest of them will work cleanly without the double lookup.

Furthermore, we do not want at all to interfere with the MSE import. This is a generic and nice mechanism that should remain like that.

All in all, the solution will work in all cases and will have a limited scope (only some 10 methods).

Cheers,
Doru


On 20 Sep 2011, at 10:49, Nicolas Anquetil wrote:

>
> Hi,
>
> (trying to follow the discussion here)
>
>
> Isn't it a mistake to design the whole pragma thing to patch a problem with a few metrics that the exporter computes?
>
> Wouldn't it be simpler to do it "the right way" (whatever it is, but independently of this issue) and them implement a work-around for this specific problem?
>
> How many metrics are they?
> How often do they change?
>
> (just asking)
>
> The work-around could be in the mse-importer, or a small processing of the mse before importing it ...
>
> nicolas
>
> ----- Mail original -----
>> De: "Tudor Girba" <[hidden email]>
>> À: "Moose-related development" <[hidden email]>
>> Envoyé: Mardi 20 Septembre 2011 09:21:45
>> Objet: [Moose-dev] Re: about <MSEProperty: #propertySignature type: #Number> <MSEComment: 'ZZZ'>
>> Hi Stef,
>>
>> First, the pragma should be:
>>
>> <MSEproperty: #afferentCoupling type: #Number>
>>
>> It's like an identifier in code.
>>
>> Then the only thing different here is what will be saved in the MSE
>> file. So, instead of AFFC, we will have afferentCoupling.
>>
>> The only real problem is in the case where we rely on looking up the
>> property in the dictionary before trying to compute it.
>>
>> Let me give you an example:
>>
>> FAMIXBehavioralEntity>>numberOfLinesOfCode
>> <MSEProperty: #numberOfLinesOfCode type: #Number>
>> <MSEComment: 'The number of lines of code in a method.'>
>>
>> ^ self lookUpPropertyNamed: #LOC computedAs: [...]
>>
>> In this case, there is a mismatch between what gets looked up in the
>> implementation (#LOC), and what is described (#numberOfLinesOfCode).
>> This is because the current external parsers export the LOC property,
>> but when we are inside Moose, we want to see numberOfLinesOfCode (it
>> reads better, and it scales better given that we tend to have a tone
>> of metrics and acronyms become confusing).
>>
>> So, after loading a model with LOC properties from MSE, by default,
>> these will get stored in the properties dictionary. Now, we still have
>> the problem that after we save the model and load it again, we will
>> lose the LOC information because now it will be stored with the
>> numberOfLinesOfCode. So, until we fix the external parsers, we can
>> have the following workaround:
>>
>> FAMIXBehavioralEntity>>numberOfLinesOfCode
>> <MSEProperty: #numberOfLinesOfCode type: #Number>
>> <MSEComment: 'The number of lines of code in a method.'>
>>
>> ^ self privateState propertyAt: #LOC ifAbsentPut: [
>> "this is to make sure we get #LOC"
>> self privateState propertyAt: #numberOfLinesOfCode ifAbsentPut: [
>> "this is to deal with the Moose #numberOfLinesOfCode"
>> ...] ]
>>
>>
>> Cheers,
>> Doru
>>
>>
>>
>> On 19 Sep 2011, at 19:40, Stéphane Ducasse wrote:
>>
>>> Doru now I understand what I do not understand
>>>
>>> When we define afferentCoupling the following way we make sure that
>>> the acronym can be used to look for the value?
>>>
>>>
>>> afferentCoupling
>>> "Afferent coupling for a class group is the number of classes that
>>> depend upon this class group"
>>>
>>> <property: #AFFC longName: 'Afferent Coupling' description:
>>> 'Afferent Coupling of a class group'>
>>>
>>> | cgClasses cgTypes |
>>> cgClasses := self allClasses select: [:c | c isInstanceSide].
>>> cgTypes := cgClasses flatCollect: [:c | c allRecursiveTypes].
>>>
>>> ^ (cgClasses flatCollect: [:aClass | aClass invokingClasses select:
>>> [: c | (cgClasses contains: [:each | each = c]) not and: [(cgTypes
>>> contains: [:each | each = c]) not and: [c isInstanceSide]]]]) asSet
>>> size
>>>
>>> Now if we rewrite it
>>>
>>> afferentCoupling
>>> "Afferent coupling for a class group is the number of classes that
>>> depend upon this class group"
>>>
>>> <MSEproperty: 'Afferent Coupling' type: #Number>
>>>
>>> | cgClasses cgTypes |
>>> cgClasses := self allClasses select: [:c | c isInstanceSide].
>>> cgTypes := cgClasses flatCollect: [:c | c allRecursiveTypes].
>>>
>>> ^ (cgClasses flatCollect: [:aClass | aClass invokingClasses select:
>>> [: c | (cgClasses contains: [:each | each = c]) not and: [(cgTypes
>>> contains: [:each | each = c]) not and: [c isInstanceSide]]]]) asSet
>>> size
>>>
>>>
>>> We do not get the fact that this metrics is associated with the
>>> #AFFC acronym
>>>
>>>
>>> So this was my question before rwriting everything.
>>>
>>>
>>> _______________________________________________
>>> Moose-dev mailing list
>>> [hidden email]
>>> https://www.iam.unibe.ch/mailman/listinfo/moose-dev
>>
>> --
>> www.tudorgirba.com
>>
>> "Problem solving efficiency grows with the abstractness level of
>> problem understanding."
>>
>>
>>
>>
>> _______________________________________________
>> Moose-dev mailing list
>> [hidden email]
>> https://www.iam.unibe.ch/mailman/listinfo/moose-dev
>
> _______________________________________________
> Moose-dev mailing list
> [hidden email]
> https://www.iam.unibe.ch/mailman/listinfo/moose-dev

--
www.tudorgirba.com

"Not knowing how to do something is not an argument for how it cannot be done."


_______________________________________________
Moose-dev mailing list
[hidden email]
https://www.iam.unibe.ch/mailman/listinfo/moose-dev
Reply | Threaded
Open this post in threaded view
|

Re: about <MSEProperty: #propertySignature type: #Number> <MSEComment: 'ZZZ'>

Stéphane Ducasse
In reply to this post by Tudor Girba-2
Thanks doru I will start to fix the 122 users of property:
and continue documenting the classes

Stef

On Sep 20, 2011, at 9:21 AM, Tudor Girba wrote:

> Hi Stef,
>
> First, the pragma should be:
>
> <MSEproperty: #afferentCoupling type: #Number>
>
> It's like an identifier in code.
>
> Then the only thing different here is what will be saved in the MSE file. So, instead of AFFC, we will have afferentCoupling.
>
> The only real problem is in the case where we rely on looking up the property in the dictionary before trying to compute it.
>
> Let me give you an example:
>
> FAMIXBehavioralEntity>>numberOfLinesOfCode
>   <MSEProperty: #numberOfLinesOfCode type: #Number>
>   <MSEComment: 'The number of lines of code in a method.'>
>
>   ^ self lookUpPropertyNamed: #LOC computedAs: [...]
>
> In this case, there is a mismatch between what gets looked up in the implementation (#LOC), and what is described (#numberOfLinesOfCode). This is because the current external parsers export the LOC property, but when we are inside Moose, we want to see numberOfLinesOfCode (it reads better, and it scales better given that we tend to have a tone of metrics and acronyms become confusing).
>
> So, after loading a model with LOC properties from MSE, by default, these will get stored in the properties dictionary. Now, we still have the problem that after we save the model and load it again, we will lose the LOC information because now it will be stored with the numberOfLinesOfCode. So, until we fix the external parsers, we can have the following workaround:
>
> FAMIXBehavioralEntity>>numberOfLinesOfCode
>   <MSEProperty: #numberOfLinesOfCode type: #Number>
>   <MSEComment: 'The number of lines of code in a method.'>
>
>   ^ self privateState propertyAt: #LOC ifAbsentPut: [
>      "this is to make sure we get #LOC"
>      self privateState propertyAt: #numberOfLinesOfCode ifAbsentPut: [
>            "this is to deal with the Moose #numberOfLinesOfCode"
>             ...] ]
>
>
> Cheers,
> Doru
>
>
>
> On 19 Sep 2011, at 19:40, Stéphane Ducasse wrote:
>
>> Doru now I understand what I do not understand
>>
>> When we define afferentCoupling the following way we make sure that the acronym can be used to look for the value?
>>
>>
>> afferentCoupling
>> "Afferent coupling for a class group is the number of classes that depend upon this class group"
>>
>> <property: #AFFC longName: 'Afferent Coupling' description: 'Afferent Coupling of a class group'>
>>
>> | cgClasses cgTypes |
>> cgClasses := self allClasses select: [:c | c isInstanceSide].
>> cgTypes := cgClasses flatCollect: [:c | c allRecursiveTypes].
>>
>> ^ (cgClasses flatCollect: [:aClass | aClass invokingClasses select: [: c | (cgClasses contains: [:each | each = c]) not and: [(cgTypes contains: [:each | each = c]) not and: [c isInstanceSide]]]]) asSet size
>>
>> Now if we rewrite it
>>
>> afferentCoupling
>> "Afferent coupling for a class group is the number of classes that depend upon this class group"
>>
>> <MSEproperty: 'Afferent Coupling' type: #Number>
>>
>> | cgClasses cgTypes |
>> cgClasses := self allClasses select: [:c | c isInstanceSide].
>> cgTypes := cgClasses flatCollect: [:c | c allRecursiveTypes].
>>
>> ^ (cgClasses flatCollect: [:aClass | aClass invokingClasses select: [: c | (cgClasses contains: [:each | each = c]) not and: [(cgTypes contains: [:each | each = c]) not and: [c isInstanceSide]]]]) asSet size
>>
>>
>> We do not get the fact that this metrics is associated with the #AFFC acronym
>>
>>
>> So this was my question before rwriting everything.
>>
>>
>> _______________________________________________
>> Moose-dev mailing list
>> [hidden email]
>> https://www.iam.unibe.ch/mailman/listinfo/moose-dev
>
> --
> www.tudorgirba.com
>
> "Problem solving efficiency grows with the abstractness level of problem understanding."
>
>
>
>
> _______________________________________________
> Moose-dev mailing list
> [hidden email]
> https://www.iam.unibe.ch/mailman/listinfo/moose-dev


_______________________________________________
Moose-dev mailing list
[hidden email]
https://www.iam.unibe.ch/mailman/listinfo/moose-dev